精华区 [关闭][返回]

当前位置:网易精华区>>讨论区精华>>编程开发>>● Delphi>>Windows API函数>>使用API的几个小技巧

主题:使用API的几个小技巧
发信人: 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] 

 

 

[关闭][返回]