本来以为东西少的说,谁知道80几条,我从后开始翻了十几条,大家一人一点帮他翻了吧
问:
如何重起WIN
Answer
两个API:ExitWindows()和ExitWindowsExec(). (见WINAPI HELP) 有人认为用DDE CALL"[Reload()]" ;不!
ExitWindows( 0, EW_RESTARTWINDOWS ) 关闭并重起WIN,可在我的DELPHI程序里它退到了DOS状态。
ExitWindowsExec 可关闭WIN,执行DOS程序,然后重起WIN。
你只要传个错误的执行文件名即可。
例如:
if (MessageDlg( 'The installation was successful! You must now ' +
'restart Windows. do
this now?', mtInformation,
[mbYes, mbNo], 0) = mrYes) then
begin
ExitWindowsExec( BOGUS_EXE, Nil );
end;
BOGUS_EXE 被声明为类似:
const
BOGUS_EXE = 'zyxwvuts.exe';
问:
自动滚屏幕
答:
procedure TForm1.Edit1KeyDown(Sender: TObject;
var Key: Word;
Shift: TShiftState);
begin
if Key = VK_F8 then
SendMessage(Memo1.Handle, { HWND of the Memo Control }
WM_VSCROLL, { Windows Message }
SB_PAGEDOWN, { Scroll Command }
0) { Not Used }
else
if Key = VK_F7 then
SendMessage(Memo1.Handle, { HWND of the Memo Control }
WM_VSCROLL, { Windows Message }
SB_PAGEUP, { Scroll Command }
0);
{ Not Used }
end;
问:
虚拟键值
答:
vk_LButton = $01;
vk_RButton = $02;
vk_Cancel = $03;
vk_MButton = $04;
{ NOT contiguous with L &
RBUTTON }
vk_Back = $08;
vk_Tab = $09;
vk_Clear = $0C;
vk_Return = $0D;
vk_Shift = $10;
vk_Control = $11;
vk_Menu = $12;
vk_Pause = $13;
vk_Capital = $14;
vk_Escape = $1B;
vk_Space = $20;
vk_Prior = $21;
vk_Next = $22;
vk_End = $23;
vk_Home = $24;
vk_Left = $25;
vk_Up = $26;
vk_Right = $27;
vk_Down = $28;
vk_Select = $29;
vk_Print = $2A;
vk_Execute = $2B;
vk_SnapShot = $2C;
vk_Copy = $2C not used by keyboards }
vk_Insert = $2D;
vk_Delete = $2E;
vk_Help = $2F;
vk_A thru vk_Z are the same as their ASCII equivalents: 'A' thru 'Z' }
vk_0 thru vk_9 are the same as their ASCII equivalents: '0' thru '9' }
vk_NumPad0 = $60;
vk_NumPad1 = $61;
vk_NumPad2 = $62;
vk_NumPad3 = $63;
vk_NumPad4 = $64;
vk_NumPad5 = $65;
vk_NumPad6 = $66;
vk_NumPad7 = $67;
vk_NumPad8 = $68;
vk_NumPad9 = $69;
vk_Multiply = $6A;
vk_Add = $6B;
vk_Separator = $6C;
vk_Subtract = $6D;
vk_Decimal = $6E;
vk_Divide = $6F;
vk_F1 = $70;
vk_F2 = $71;
vk_F3 = $72;
vk_F4 = $73;
vk_F5 = $74;
vk_F6 = $75;
vk_F7 = $76;
vk_F8 = $77;
vk_F9 = $78;
vk_F10 = $79;
vk_F11 = $7A;
vk_F12 = $7B;
vk_F13 = $7C;
vk_F14 = $7D;
vk_F15 = $7E;
vk_F16 = $7F;
vk_F17 = $80;
vk_F18 = $81;
vk_F19 = $82;
vk_F20 = $83;
vk_F21 = $84;
vk_F22 = $85;
vk_F23 = $86;
vk_F24 = $87;
vk_NumLock = $90;
vk_Scroll = $91;
Question
如何获得DOS/WIN版本号?
Answer
用API GetVersion ,不过结果被编码了:
Type
TGetVer = record
WinVer,
WinRev,
do
sRev,
do
sVer: Byte;
end;
const
VerStr = '%d.%d';
procedure TForm1.Button1Click(Sender: TObject);
var
AllVersions: TGetVer;
begin
AllVersions := TGetVer(GetVersion);
Edit1.Text := Format(VerStr, [AllVersions.WinVer, AllVersions.WinRev]);
Edit2.Text := Format(VerStr, [AllVersions.DOSVer, AllVersions.DOSRev]);
end;
注:返回的版本和真实版本未必相同;
Note2: Win32应用程序需要用GetVersionEx
问:
如何让程序标题闪烁?
Answer
用 FlashWindow API ,FlashWindow 有两个参数,第一个是闪烁窗体的句柄,第二个是BOOLEAN类型,
使闪烁(True) 或还原 (False)。
最好和TIMER一起用以下代码在你timer的OnTimer事件处理程序中:
procedure TForm1.Timer1Timer(Sender: TObject);
begin
FlashWindow(Handle, True) ;
end;
如果你希望你最小化后程序的图标闪烁,你需要改变调用方式,不需要台传递程序的句柄
procedure TForm1.Timer1Timer(Sender: TObject);
begin
FlashWindow(Application.Handle, True) ;
end;
你可以毫无影响的同时使用他们。
问:
我如何知道菜单每项可显示的行?
答:
这样:
function TForm1.MemoLinesShowing(memo: TMemo): integer;
var
R: TRect;
begin
Memo.Perform(EM_GETRECT, 0, Longint(@R));
Result := (R.Bottom - R.Top) div Canvas.TextHeight('XXX');
end;
问题是,TForm 和TMemo 需要用同样的字体。
如果不同,可以用以下代码:
function TForm1.MemoLinesShowingLong(Memo: TMemo): integer;
Var
Oldfont: HFont;
{the old font}
DC: THandle;
{Device context handle}
i: integer;
{loop variable}
Tm: TTextMetric;
{text metric structure}
TheRect: TRect;
begin
DC := GetDC(Memo.Handle);
{Get the memo's device context}
try
{Select the memo's font}
OldFont := SelectObject(DC, Memo.Font.Handle);
try
GetTextMetrics(DC, Tm);
{Get the text metric info}
Memo.Perform(EM_GETRECT, 0, longint(@TheRect));
Result := (TheRect.Bottom - TheRect.Top) div
(Tm.tmHeight + Tm.tmExternalLeading);
finally
SelectObject(DC, Oldfont);
{Select the old font}
end;
finally
ReleaseDC(Memo.Handle, DC);
{Release the device context}
end;
end;
Exiting Windows from within a Delphi app
问:
如何退出WINDOWS?
答:
有时你的确需要让用户退出或重启WIN,这很简单。
语法取决于你用WIN3.X还是95/NT。如为3.X你要用ExitWindows API。它两个参数,第二个始终为0。第一个参数也可为0,
它将退出WINDOWS,或者,使用以下两者之一:ew_RebootSystem 或者 ew_RestartWindows, (WINAPI说,第一个参数始终为0,别上当)。
如果是9X/NT,你需要ExitWindowsEx API。像ExitWindows, ExitWindowsEx 也有两个参数,第二个始终为0。需要重启系统或重启WIN,用ewx_Reboot 作为第一个参数,你也可用ewx_PowerOff
来关闭系统。你也可以将它们与参数ewx_Force一起用,以强制关闭所有的进程。
注意:ExitWindows在95/NT下只能起重新登录的效果。
95/NT下:如果你要关闭系统,你必须有SE_SHUTDOWN_NAME权限。好象这是默认的。
可以使用AdjustTokenPrivileges API function, 这在WINAPI有说明。
问:
我想在我的程序模拟用户按RETURN。
答:
你可以发条消息:
PostMessage(FWinControl.Handle, WM_KEYDOWN, VK_BACK, 0);
这是BACK SPACE的情况。
问:
我想重起WIN,但不重起计算机
答:
这里有例子:
procedure TMainForm.RestartWindowsBtnClick(Sender: TObject);
begin
if not ExitWindows(EW_RestartWindows, 0) then
ShowMessage('An application refused to terminate');
end;
procedure TMainForm.RebootSystemBtnClick(Sender: TObject);
begin
if not ExitWindows(EW_RebootSystem, 0) then
ShowMessage('An application refused to terminate');
end;
文档有错误,我觉得正确的应该如此:
function ExitWindows (dwReturnCode: Longint;
Reserved: Word): Bool;
问:
如何在系统菜单加入项?
问:
A:
这个过程可以:
procedure AppendToSystemMenu (Form: TForm;
Item: string;
ItemID: Word);
{----------------------------------------------------------------}
{ Appends menu item to end of system menu of specified form and }
{ to system menu of application's minimized icon. To append a }
{ separator bar start the item with '-' (and use 0 for ItemID). }
{----------------------------------------------------------------}
var
NormalSysMenu, MinimizedMenu: HMenu;
AItem: array[0..255] of Char;
PItem: PChar;
begin
NormalSysMenu := GetSystemMenu(Form.Handle, false);
MinimizedMenu := GetSystemMenu(Application.Handle, false);
if StartsWith('-', Item) then
AppendMenu(NormalSysMenu, MF_SEPARATOR, 0, nil);
AppendMenu(MinimizedMenu, MF_SEPARATOR, 0, nil);
end
else
begin
PItem := StrPCopy(PChar(@AItem), Item);
AppendMenu(NormalSysMenu, MF_STRING, ItemID, PItem);
AppendMenu(MinimizedMenu, MF_STRING, ItemID, PItem);
end
end;
{AppendToSystemMenu}
过程是如下定义:
function StartsWith (const StartString, theString: string)
: Boolean;
{----------------------------------------------------------------}
{ Tests whether or not theString starts with the StartString. }
{ N.B. Case sensitive. }
{----------------------------------------------------------------}
begin
if Copy(theString, 1, length(StartString)) = StartString then
StartsWith := True
else
StartsWith := False
end;
{StartsWith}
A:
建立新FORM
type
TForm1 = class(TForm)
private
{ Private declarations }
public
procedure WinMsgHandler( var Msg : TMsg;
var Handled : Boolean );
{ Public declarations }
end;
const
WM_ABOUT = WM_USER + 1;
{ About message }
IMPLEMENTATION
procedure TForm1.WinMsgHandler( var Msg : TMsg;
var Handled : Boolean );
begin
If Msg.Message = WM_SYSCOMMAND then
begin
if Msg.wParam = WM_ABOUT then
Showmessage('Hello World!!');
end;
end;
你必须在窗体中加入以下方法:
Application.OnMessage := WinMsgHandler;
{Use my message handler}
AppendMenu( GetSystemMenu( Self.Handle, False ),
MF_SEPARATOR, 0, '');
{Append our new value}
AppendMenu( GetSystemMenu( rm1.FormCreate(Sender: TObject);
begin
AppendMenu(GetSystemMenu(Handle, False), { API call;
see API Help }
MF_STRING, SC_UDF, '&About');
AppendMenu(GetSystemMenu(Application.Handle, False),
MF_STRING, SC_UDF, '&About');
Application.OnMessage := AppOnMessage;
end;
procedure TForm1.AppOnMessage(VAR Msg: TMsg;
VAR Handled: BOolean);
VAR
Hf, Ha : hMenu;
Checkd : Boolean;
CONST
NuFlag : ARRAY[Boolean] OF Word = (MF_CHECKED, MF_UNCHECKED);
NuHWnd : ARRAY[Boolean] OF HWnd = (HWND_TOPMOST, HWND_NOTOPMOST);
begin
IF Msg.Message WM_SYSCOMMAND then
Exit;
IF Msg.wParam AND $FFF0 SC_UDF then
Exit;
{ show your About Dialog }
end;
end.
问:
如我用GetModuleFileName, 我不能使它工作,我觉得问题在第一个参数hInstance,
stuff := GetWindowLong(168, GWL_hINSTANCE);
GetModuleFileName(stuff, buf, 100);
答:
procedure TForm1.Button1Click(Sender: TObject);
var
szFileName : array[0..49] of char;
szModuleName : array[0..19] of char;
iSize : integer;
begin
StrPCopy(szModuleName, 'NameOfModule');
iSize := GetModuleFileName(GetModuleHandle(szModuleName),szFileName,
SizeOf(szFileName));
if iSize > 0 then
ShowMessage('Full path name is : ' + StrPas(szFileName))
else
ShowMessage('Path of module not found');
end;
问:
在MOUSE移入和移出一个控件时,系统会发什么消息?
答:
DELPHI预定义的两个消息:
CM_MOUSEENTER 和 CM_MOUSELEAVE。 Below 已经提供了部分使用它们的代码,
我试了,对TSPEEDBUTTON有效,相信对其它也有效。
unit SomeForm;
interface
type
TSomeForm = class(TForm)
private
procedure CMMouseEnter(var Msg: TMessage);
message CM_MOUSEENTER;
procedure CMMouseLeave(var Msg: TMessage);
message CM_MOUSELEAVE;
end;
implementation
procedure TSomeForm.CMMouseEnter(var Msg: TMessage);
var
anObject : TObject;
begin
{ anObject is the control over which the mouse is right now }
anObject := TObject(Msg.lParam);
if anObject nil then
begin
{ First, you must find WHICH is the control under the mouse cursor, }
{ then
, determine what action todo
, etc... }
end;
end;
procedure TSomeForm.CMMouseLeave(var Msg: TMessage);
begin
{ anObject is the control which the mouse has just gone out of }
anObject := TObject(Msg.lParam);
if anObject nil then
begin
{ First, you must find WHICH is the control }
{ the mouse cursor has just left, }
{ then
, determine what action todo
, etc... }
end;
end;
end.