Windows API函数使用技巧
得到WINDOWS的SYSTEM路径:
方法:
var
MySysPath : PCHAR ;
begin
GetMem(MySysPath,255);
GetSystemDirectory(MySysPath,255);
end;
注:MySysPath为SYSTEM路径
得到程序的路径
ExtractFileDir(Application.Exename);
察看文件是否存在
FileExists(FileName:String):Boolean;
改变文件扩展名
ChangeFileExt(FileName:String)
得到文件的扩展名
ExtractFileExt(FileName:String):String;
如何取得Windows的临时文件目录?
适合版本:Delphi 3,2.0,1.0
Windows 95 & NT都指定了放置临时文件的目录，然而，用户能改变临时目录的位置而不使用缺省的目录。这篇文章的目的是告诉你如何得到Windows 95 & NT当前的临时目录位置。这个Windows API函数 GetTempPath就是解决这个问题的。其函数原形为:
DWORD GetTempPath(DWORD nBufferLength, LPTSTR lpBuffer);
下面的例子示范如何使用：
function GetTempDirectory: String;
var
TempDir: array[0..255] of Char;
begin
GetTempPath(255, @TempDir);
Result := StrPas(TempDir);
end;
备注：临时目录的确定原则：
1,如果有TMP环境变量则临时目录为TMP指定的目录
2,如果没有TMP环境变量而有TEMP环境变量，则为TEMP变量指定的目录
3,如果TMP和TEMP都没有定义，则取当前目录为临时目录
程序不出现在任务栏
一般Windows 95运行程序时都会在任务栏上出现按钮，如果你的程序是一个监视程序，那么出现按钮就不是明智之举了。要实现该功能就要在OnCreate事件里利用到API函数SetWindowLong
procedure TForm1.FormCreate(sender:TObject);
begin
SetWindowLong(Application,Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);
end;
改计算机名
改变计算机在网络中的名字，重新启动后才生效
SetComputerName('Hello World');
控制热启动
要使系统的热启动键（Ctrl+Alt+Del）失效，使用以下语句
SystemParametersInfo(SPI_SCREENSAVERRUNNING, 1, 0, 0);
要恢复系统的热启动键（Ctrl+Alt+Del），使用以下语句
SystemParametersInfo(SPI_SCREENSAVERRUNNING, 0, 0, 0);
临时路径
有时需要Windows的临时路径来做备份等工作，那么就要知道路径在哪，下面的程序帮你忙：
var aa:pchar;
begin
GetTempPath(20,aa); file://返回路径名
edit1.text:=aa;
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;
关闭Windows
控制WINDOWS的开关：如关闭WINDOWS，重新启动WINDOWS等, ExitWindowsEx(UINT uFlags,DWORD dwReserved);是实现这一功能的API函数
首先定义常数
const
EWX_FORCE=4; file://关闭所有程序并以其他用户身份登录
EWX_LOGOFF=0; file://重新启动计算机并切换到MS-DOS方式
EWX_REBOOT=2; file://重新启动计算机
EWX_SHUTDOWN=1;//关闭计算机
运行时给How赋值，让他等于EWX_SHUTDOWN或其他，调用以下语句
ExitWindowsEx(How,0);
关闭外部应用程序
如何在 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;
得到执行程序的目录
SysUtils 单元中有 ExtractFileDir 与 ExtractFilePath两个类似的函数, 用哪一个?没有太大的关系。
不过有以下的差别: ExtractFilePath 传回值的最後一个字元是反斜杠“／”。
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(ExtractFileDir(Application.Exename));
// ie: c:\temp
ShowMessage(ExtractFilePath(Application.Exename));
// ie: c:\tempend;
相同点： 如果执行文件在根目录下(如：C:\SAMPLE.EXE)的话, 两者的传回值相同， 且最后一个字符都是“／”。
使用GetFileVersionInfo 得到版本信息的例子
Samples Using GetFileVersionInfo?
回答1:
procedure GetBuildInfo(var V1, V2, V3, V4: Word);
var
VerInfoSize: DWORD;
VerInfo: Pointer;
VerValueSize: DWORD;
VerValue: PVSFixedFileInfo;
Dummy: DWORD;
begin
VerInfoSize := GetFileVersionInfoSize(PChar(ParamStr(0)), Dummy);
GetMem(VerInfo, VerInfoSize);
GetFileVersionInfo(PChar(ParamStr(0)), 0, VerInfoSize, VerInfo);
VerQueryValue(VerInfo, '\', Pointer(VerValue), VerValueSize);
with VerValue^ do
begin
V1 := dwFileVersionMS shr 16;
V2 := dwFileVersionMS and $FFFF;
V3 := dwFileVersionLS shr 16;
V4 := dwFileVersionLS and $FFFF;
end;
FreeMem(VerInfo, VerInfoSize);
end;
------------------------------------------
回答2
If you want a component, check out TVersionInfoResource at
http://www.pobox.com/~bstowers/delphi/ in the My Stuff section. D1/D2/D3/C++B
compatible, freeware with full source code and a small demo.
And you can see the http://www.aye.net/~bstowers/delphi/
另一个component VersionInfo.zip
防止程序运行多个例程?
More than one instance of program?
回答
This is copied direct from my *.dpr file. You can work it for your own
use.
var
hMutex : Thandle;
WaitResult : word;
BroadcastList : DWORD;
begin
MessageID := RegisterWindowMessage('Check For Choice Previous Inst');
// register a message to use later on
hMutex := createMutex(nil,false,pchar('App_Choice')); // grab a mutex
handle
WaitResult := WaitForSingleObject(hMutex,10); // wait to see
if we can have exclusive use of the mutex
if ( waitResult = WAIT_TIMEOUT ) then // if we can't then broadcast
the message to make the owner of the mutex respond
{ request that the running application takes focus }
begin
BroadcastList := BSM_APPLICATIONS;
BroadcastSystemMessage(
BSF_POSTMESSAGE,@BroadcastList,MessageID,0,0); file://32 bit - broadcast the
message to all apps - only a prev inst will hear it.
end
else
begin
{ do the normal stuff}
Application.Title := 'Choice Organics Purchase & Sales System';
Application.CreateForm(TMainForm, MainForm);
Application.Run;
ReleaseMutex(hMutex); // release the mutex as a politeness
end;
CloseHandle(hMutex); // close the mutex handle
end.
This goes in the MainForm
procedure Tmainform.OnAppMessage(var Msg : TMsg ; Var Handled : Boolean);
begin
{ If it's the special message then focus on this window}
if Msg.Message = MessageID then // if we get the broadcast message from an
another instance of this app that is trying to start up
begin
show;
WindowState := wsMaximized;
BringToFront;
SetFocus;
Handled := true;
end;
end;
file://And this goes in the TMainForm.FormCreate ;-
Application.OnMessage:= OnAppMessage;
4.得到Win 95 的计算机名字?
问 How can I learn Windows'95 Machine Name?
答function ComputerName : String;
var
CNameBuffer : PChar;
fl_loaded : Boolean;
CLen : ^DWord;
begin
GetMem(CNameBuffer,255);
New(CLen);
CLen^:= 255;
fl_loaded := GetComputerName(CNameBuffer,CLen^);
if fl_loaded then
ComputerName := StrPas(CNameBuffer)
else
ComputerName := 'Unkown';
FreeMem(CNameBuffer,255);
Dispose(CLen);
end;
7. 停止一个线程？
问 Stop A Thread?
回答
You can Terminate your thread in two ways:
1) Assign ThreadDone to OnTerminate when you create it.
In the Execute method, exit when the terminated property is True.
At the point where you want to stop, issue the Terminate method.
2) Just call the Suspend method.
After one of these steps you may free the thread.
I hope the following snippets will help.
// -------------------------------------------------------------- //
interface
type
Txyz = class(TThread)
published
procedure Execute; override;
end;
var
XYZThread: Txyz;
implementation
procedure Txyz.Execute;
begin
while True do Application.ProcessMessages;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
XYZThread := Txyz.Create(False);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
XYZThread2.Suspend;
XYZThread2.Free;
end;
end.
如何在WINDOWS中象在UCDOS下控制打印字体的长宽，而不受限于SIZE 的限制。
首先为了达到这个功能，可以采用Windows的逻辑字体(LogFont)
可以使用 CreateFont 或 CreateFontIndirect 这两个Windows API
函数来定义任何想要的字体，由于 CreateFont 所需的参数甚多通常
我们使用 CreateFontIndirect 来建立所需的逻辑字体，这个API函数
在Delphi中的声明为
function CreateFontIndirect(const p1: TLogFont): HFONT; stdcall;
其中只有一个参数 p1: TLogfont, 所有有关字体的参数完全通过这个
TLogfont结构来传送，Windows将根据结构中的内容创建出相应的逻辑
字体，在Delphi的Windows.pas中TLogFont是这样定义的
TLogFontA = packed record
lfHeight: Longint;
lfWidth: Longint;
lfEscapement: Longint;
lfOrientation: Longint;
lfWeight: Longint;
lfItalic: Byte;
lfUnderline: Byte;
lfStrikeOut: Byte;
lfCharSet: Byte;
lfOutPrecision: Byte;
lfClipPrecision: Byte;
lfQuality: Byte;
lfPitchAndFamily: Byte;
lfFaceName: array[0..LF_FACESIZE - 1] of AnsiChar;
end;
TLogFontW = packed record
lfHeight: Longint;
lfWidth: Longint;
lfEscapement: Longint;
lfOrientation: Longint;
lfWeight: Longint;
lfItalic: Byte;
lfUnderline: Byte;
lfStrikeOut: Byte;
lfCharSet: Byte;
lfOutPrecision: Byte;
lfClipPrecision: Byte;
lfQuality: Byte;
lfPitchAndFamily: Byte;
lfFaceName: array[0..LF_FACESIZE - 1] of WideChar;
end;
TLogFont = TLogFontA;
其中涉及到很多参数，其中
lfHeight: Longint;
指定以逻辑单位标定的字体高度，取值可为正负或零，对于需要随意
定义字体高度的情况下通常取负值，以保证获得实际尺寸的字体。
lfWidth: Longint;
用于指定字体的平均宽度，由于Windows系统下的大多数字体都是比例
字体因而采用平均宽度这个表示方法。若指定为0，则系统会自动根据
适当的比例自动处理宽度。
lfEscapement: Longint;
指定输出方向与当前坐标系X轴之间的以十分之一度为单位的角度。
lfOrientation: Longint;
指定每个字符与当前坐标系X轴之间的以十分之一度为单位的角度。在
Windows95中这个值等同于lfEscpement。
lfWeight: Longint;
指定范围为从0至1000的字体加重程度，400是标准字体700为加重字体，
0表示采用默认值。
lfItalic: Byte;
不为0表示采用斜体字。
lfUnderline: Byte;
不为0表示带下划线。
lfStrikeOut: Byte;
不为0表示带穿透线。
lfCharSet: Byte;
指定字体集。
lfOutPrecision: Byte;
指定输出精度。用于确定对前面一些设定值的精确程度。
lfClipPrecision: Byte;
指定裁剪精度。裁剪是Windows图形环境下的一种特殊处理，简单说就是
去掉图形中落在视图以外的部分，有助于提高图形的处理速度。
lfQuality: Byte;
指定输出质量。
lfPitchAndFamily: Byte;
指定字体的Pitch和Family。
lfFaceName: array[0..LF_FACESIZE - 1] of AnsiChar;
指定采用的字体名称。
在建立逻辑字体时，我们通常使用
lfHeight和lfWidth来确定字体的尺寸，使用lfEscapement和lfOrientation
来确定字体的输出方向，使用lfWeight, lfItalic, lfUnderline,
lfStrikeOut, 来确定字体的加重，斜体，下划线和穿透线，使用lfCharSet
来确定字体的字符集，通常采用系统默认的字符集。
对于lfOutPrecision, lfClipPrecision, lfQuality一般应用于对屏幕之外
的输出设备，通常采用默认值。采用lfPitchAndFamily来确定采用定宽或可
变字体和字体的家族。以lfFaceName来通过名称选择采用的字体。
另外应当注意在Windows环境下，每种字体具体输出为何种形式取决于很多
因素，需要对以上这些参数进行有效的组合才能达到所要的效果。
