发信人: daji(妲姬)
整理人: teleme(2001-04-27 09:18:13), 站内信件
|
//*******************************************
是一种检测程序是在运行还是停止响应的函数。
主要是使用 SendMessageTimeout。
function isHung(theWindow: HWnd; timeOut: Longint): Boolean;
var
dwResult: DWord;
begin
Result := SendMessageTimeout(theWindow, WM_NULL, 0, 0, SMTO_ABORTIFHUNG Or SMTO_BLOCK, timeOut, dwResult) <> 0;
end;
呵呵，简单的有点过分了吧！
//************************************
使桌面图标的标题为透明背景
作 者: daji(妲姬) 2001-04-27 02:47:10 :0 :0
Windows的桌面属性对话框并没有使桌面图标标题为透明的选项，使得在使用墙纸时总有一块为背景色的区域，下面是使其为透明的代码。
首先，找到包括图标的窗口，即桌面的句柄。
uses Windows;
function GetDesktopIconWindow: HWND;
begin
Result := FindWindow(PChar('Progman'), PChar('Program Manager'));
Result := FindWindowEx(Result, 0, PChar('SHELLDLL_DefView'), nil);
Result := FindWindowEx(Result, 0, PChar('SysListView32'), nil);
end;
然后，实现透明效果：
uses Windows, CommCtrl;
procedure SetDesktopIconTransparent;
var
Desktop : HWND;
begin
Desktop := GetDesktopIconWindow;
ListView_SetTextBkColor(Desktop, MAXDWORD);
ListView_RedrawItems(Desktop, 0, Pred(ListView_GetItemCount(Desktop)));
UpdateWindow(Desktop);
end;
BTW，还可以设置图标标题文字和背景的颜色。
uses Windows, CommCtrl, Graphics;
procedure SetDesktopIconColors(const FColor, BColor: TColor);
var
Desktop : HWND;
begin
Desktop := GetDesktopIconWindow;
ListView_SetTextColor(Desktop, FColor);
ListView_SetTextBkColor(Desktop, BColor);
ListView_RedrawItems(Desktop, 0, Pred(ListView_GetItemCount(Desktop)));
UpdateWindow(Desktop);
end;
其中 FColor 是前景色，BColor 是背景色。
最后，是恢复原来的样子。
uses Windows;
procedure ResetDesktopIconColors;
var
Kind, Color : Integer;
begin
Kind := COLOR_DESKTOP;
Color := GetSysColor(COLOR_DESKTOP);
SetSysColors(1, Kind, Color);
end;
//******************************
取得/设置菜单的字体大小
{ 返回菜单字体尺寸 }
function GetMenuFontSize: Integer;
var
ncm: TNonClientMetrics;
PixelsPerInch: integer;
begin
ncm.cbSize := sizeof(TNonClientMetrics);
SystemParametersInfo(SPI_GETNONCLIENTMETRICS, sizeof(NONCLIENTMETRICS), @ncm, SPIF_UPDATEINIFILE);
PixelsPerInch := GetDeviceCaps(GetDC(0), LOGPIXELSY);
Result := -MulDiv(ncm.lfMenuFont.lfHeight, 72, PixelsPerInch);
end;
{ 设置菜单字体尺寸 }
procedure SetMenuFontSize(FontSize: Integer);
var
ncm: TNonClientMetrics;
PixelsPerInch: Integer;
begin
ncm.cbSize := sizeof(TNonClientMetrics);
SystemParametersInfo(SPI_GETNONCLIENTMETRICS, sizeof(NONCLIENTMETRICS), @ncm, 0);
PixelsPerInch := GetDeviceCaps(GetDC(0), LOGPIXELSY);
ncm.lfMenuFont.lfHeight := -MulDiv(FontSize, PixelsPerInch, 72);
SystemParametersInfo( SPI_SETNONCLIENTMETRICS, sizeof(NONCLIENTMETRICS), @ncm, SPIF_UPDATEINIFILE);
end;
//***********************
控制电源的组件
在一件组件中实现了关机(ShutDown), 重启(ReBoot), 注销(LogOff), 弹出光驱,显示器节能。
unit PowerControl;
interface
uses WinTypes, WinProcs, Messages, SysUtils, Classes, Controls,
Forms, Graphics, MMSystem;
type
TAction = (actLogOFF,
actShutDown,
actReBoot,
actForce,
actPowerOFF,
actForceIfHung,
actMonitorOFF,
actMonitorON,
actCDEject,
actCDUnEject);
type
TPowerControl = class(TComponent)
private
FAction : TAction;
procedure SetAction(Value : TAction);
protected
public
function Execute : Boolean;
published
property Action : TAction read FAction write SetAction;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('K2', [TPowerControl]);
end;
procedure TPowerControl.SetAction(Value : TAction);
begin
FAction := Value;
end;
function TPowerControl.Execute : Boolean;
begin
with (Owner as TForm) do
case FAction of
actLogOff : ExitWindowsEx(EWX_LOGOFF,1);
actShutDown : ExitWindowsEx(EWX_SHUTDOWN,1);
actReBoot : ExitWindowsEx(EWX_REBOOT,1);
actForce : ExitWindowsEx(EWX_FORCE,1);
actPowerOff : ExitWindowsEx(EWX_POWEROFF,1);
actForceIfHung : ExitWindowsEx(EWX_FORCEIFHUNG,1);
actMonitorOFF : SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 0);
actMonitorON : SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, -1);
actCDEject : mciSendstring('SET CDAUDIO DOOR OPEN WAIT',nil,0, Handle);
actCDUnEject : mciSendstring('SET CDAUDIO DOOR CLOSED WAIT',nil,0, Handle);
end; {Case}
Result := True;
end;
end.
使用方法：
=====================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
PowerControl1.Action:=actCDEject;
PowerControl1.Execute;
end;
----
^^ `_ ,
^^ | | | Hello, -(_)-
^^ )_) )_) )_) My Friends! , `
姬海涵 )___))___))___)\ ,
)____)____)_____)\\ __)\_
妲姬网苑 _____|____|____|____\\\__ (\_.-' a`-.
---------\ /--------(/~~````(/~^^`--------
^^^^^ ^^^^^^^^^^^^^^^^^^^^^ http://daji.xoasis.com
^^^^ ^^^^ ^^^ ^^ [email protected]
|
|