銀幕待機(含原始碼) |
|
banson1716
高階會員 發表:55 回覆:182 積分:167 註冊:2002-04-14 發送簡訊給我 |
銀幕待機 引用 wnhoo會員的熱鍵
http://delphi.ktop.com.tw/topic.php?TOPIC_ID=30935
引用 pceyes會員的函式 GetHandleFromWindowTitle
http://delphi.ktop.com.tw/topic.php?topic_id=29551 臨時叫醒螢幕輕敲任一鍵或移動滑鼠 讓程式視窗顯示在上層的熱鍵 ctrl Alt A
設 Form1.BorderStyle :=bsDialog;//程式顯示在上層
游標移至右下方小圖示顯示視窗在上層
------------------------------------------------------------------
unit screen; interface uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, SHELLAPI;
const
MY_MESSAGE = WM_USER 100; type
TForm1 = class(TForm)
Timer1: TTimer;
Panel1: TPanel;
Label2: TLabel;
Edit1: TEdit;
Label1: TLabel;
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
procedure ON_WM_HOTKEY(var m:TMessage);message WM_HOTKEY;
procedure OnIconNotify(var Message: TMessage);message MY_MESSAGE;
{ Private declarations }
public
{ Public declarations }
end; var
Form1: TForm1; function GetHandleFromWindowTitle(TitleText: String): hWnd; implementation {$R *.DFM} function GetHandleFromWindowTitle(TitleText: String): hWnd;
var
StrBuf: Array[0..$FF] of Char;
begin
Result := FindWindow(PChar(0), StrPCopy(StrBuf, TitleText));
end; procedure TForm1.ON_WM_HOTKEY(var m: TMessage);
begin
if(m.WParam=123)then
SetForegroundWindow(GetHandleFromWindowTitle('銀幕待機'));
end; procedure TForm1.OnIconNotify(var Message: TMessage);
const
Busy: Boolean = false;
begin
if not Busy then
begin
Busy := true;
if Message.LParam=WM_LBUTTONDOWN then
if Application.MessageBox('你確定要離開嗎 ? ','離開
',MB_YESNO)=IDYES then
Close;
Busy := false;
end;
end; procedure TForm1.Timer1Timer(Sender: TObject);
begin
Sendmessage(Application.Handle,WM_SYSCOMMAND,SC_MONITORPOWER,-1);
timer1.enabled:=false;
end; procedure TForm1.FormCreate(Sender: TObject);
var
nid: TNotifyIconData;
begin
RegisterHotKey(Handle,123,MOD_CONTROL MOD_ALT,integer('A'));
timer1.enabled:=false;
nid.cbSize := sizeof(nid);
nid.Wnd := Handle;
nid.uID := 1;
nid.hIcon := Application.Icon.Handle;
nid.szTip := '銀幕待機';
nid.uCallbackMessage := MY_MESSAGE;
nid.uFlags := NIF_ICON or NIF_TIP or NIF_MESSAGE;
if not Shell_NotifyIcon(NIM_ADD, @nid) then
begin
ShowMessage('失敗了!');
Application.Terminate;
end;
SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
end; procedure TForm1.Button1Click(Sender: TObject);
begin
edit1.SetFocus;
timer1.interval:=Strtoint(Edit1.Text)*1000;
Sendmessage(Application.Handle,WM_SYSCOMMAND,SC_monitorpower,2);
timer1.enabled:=true;
end; procedure TForm1.FormShow(Sender: TObject);
begin
edit1.SetFocus;
end; procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
nid: TNotifyIconData;
begin
nid.cbSize := sizeof(nid);
nid.uID := 1;
nid.Wnd := Handle;
Shell_NotifyIcon(NIM_DELETE, @nid);
end; end.
附加檔案:32053_螢幕待機.rar
|
China Join
中階會員 發表:81 回覆:242 積分:89 註冊:2003-03-12 發送簡訊給我 |
本站聲明 |
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇! |