| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Завершение работы.

Влад ©   (2007-01-13 14:05:00) 

Честно говоря, слабо себе представляю принцип действия программы.
(Код списал из книжки). Суть проста: иконка в трее, правая кнопка мыши - меню. Надо решить такую проблему: при завершении работы винды программа упорно не хочет закрываться, соответственно и комп не выключается.

unit wall1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, ExtCtrls, StdCtrls, Registry, JPEG, ShellApi, Menus;

type
 TForm1 = class(TForm)
   PopupMenu1: TPopupMenu;
   N1: TMenuItem;
   N2: TMenuItem;
   N3: TMenuItem;
   Timer1: TTimer;
   procedure loadlist;//эту и некоторые другие процедуры я опущу, не нужны они здесь
   procedure WndProc(var Message: TMessage);
   procedure FormCreate(Sender: TObject);
   procedure N1Click(Sender: TObject);//..
   procedure N3Click(Sender: TObject);
   procedure N2Click(Sender: TObject);//..
   procedure Timer1Timer(Sender: TObject);//..
 private
   { Private declarations }
 public
    { Public declarations }
 end;

var
 Form1: TForm1;
 s:TStringlist;
 Ico_Message: integer=wm_User;
noIconData: TNotifyIconData;
HIcon1: hIcon;
FHandle: HWnd;

implementation

uses wallopt;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
FHandle := AllocateHWnd(WndProc);
 HIcon1:=CopyIcon(Application.Icon.Handle);
with noIconData do begin
 cbSize:=Sizeof(TNotifyIconData);
 Wnd:=FHandle;
 uID:=0;
 UFlags:=NIF_MESSAGE or NIF_ICON or NIF_TIP;
 SzTip:='Wallchanger';
 HIcon:=HIcon1;
 uCallBackMessage:=Ico_Message;
end;
Shell_NotifyIcon(NIM_ADD,@noIconData);
Application.ShowMainForm:=false;
end;

procedure TForm1.WndProc(var Message: TMessage);
var pt:Tpoint;
begin
if Message.Msg = Ico_Message then begin
 if Message.lParam=WM_RBUTTONUP then begin
 getcursorpos(pt);
 Form1.popupmenu1.popup(pt.x,pt.y);
 end;
 if Message.lParam=WM_LBUTTONDBLCLK then Form1.N1Click(form1);
end;
end;

procedure TForm1.N3Click(Sender: TObject);//выход
begin
deallocatehwnd(Fhandle);
Shell_NotifyIcon(NIM_DELETE,@noIconData);
S.Free;
halt;
end;

end.


---

Влад   (2007-01-13 19:10:00) [1]

> deallocatehwnd(Fhandle);

Сам разобрался. Вот эта строчка лишняя.

---

Влад   (2007-01-13 17:01:00) [2]

> Garacio ©   (13.01.07 15:04) [4]

Этот код конечно полезный, но немножко не тот: он просто завершает работу винды.

---

Garacio   (2007-01-13 15:04:00) [3]

Я и сам новичок, но мне этот код помог в таком-же вопросе:

program TurnOff;

uses Windows;

{$R *.res}

var
htkThread: THandle;
tmp : TTokenPrivileges;
dfg : PTokenPrivileges;
luid : Int64;
len : Cardinal;
begin
 OpenProcessToken(GetCurrentProcess(), TOKEN_WRITE, htkThread);
 tmp.PrivilegeCount := 1;
 LookupPrivilegeValue(nil , pchar('SeShutdownPrivilege'), luid);
 tmp.Privileges[0].Luid := Luid;
 tmp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
 dfg := nil;
 len := 0;
 AdjustTokenPrivileges(htkThread, false, tmp, 0, dfg, len);
 ExitWindowsEx(EWX_POWEROFF, 0);
end.

---

Влад   (2007-01-13 15:00:00) [4]

К сожалению, ничего не изменилось.

---

Влад   (2007-01-13 14:29:00) [5]

Спасибо, попробую.

---

kaZaNoVa   (2007-01-13 14:09:00) [6]

halt(1);
ExitProcess(0);

---

Наверх