Windows API函数使用技巧(2)

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;

标签：

版权申明：本站文章部分自网络，如有侵权，请联系：west999com@outlook.com
特别注意：本站所有转载文章言论不代表本站观点，本站所提供的摄影照片，插画，设计作品，如需使用，请与原作者联系，版权归原作者所有