[Gudzik11]

вот исходник

Код:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    pmTreyMenu: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Timer1: TTimer;
    Timer2: TTimer;
    N3: TMenuItem;
    N4: TMenuItem;
        {Трей}
    Procedure ControlWindow(Var Msg:TMessage); message WM_SYSCOMMAND;
    Procedure IconMouse(var Msg:TMessage); message WM_USER+1;
    Procedure  Ic(n:Integer;Icon:TIcon);
    Procedure OnMinimizeProc(Sender:TObject);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
  private
    { Private declarations }
    id1, id2, id3, id4: Integer;
     procedure WMHotKey(var Msg: TWMHotKey); message WM_HOTKEY;
     function AddNull(InpTime: String): String;
     function MyExitWindows(RebootParam: Longword): Boolean;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  x: Word;
   Chas: TTime;
  sec: TTime;

implementation

uses Unit2, Unit3;

{$R *.dfm}

  function IsAutorun: Boolean;
var
  reg: TRegistry;
begin
  Result := false;
  reg := TRegistry.Create;
  reg.RootKey := HKEY_LOCAL_MACHINE;
  If Reg.OpenKey('\Software\Microsoft\Windows\CurrentVersion\Run', false) then
    begin
      If reg.ValueExists('Proga') then
        Result :=  LowerCase(reg.ReadString('Proga')) = LowerCase(ParamStr(0));
      reg.CloseKey;
    end;
  reg.Free;
end;

 {======================================}
{Методы для добавления программы в трей}
{======================================}
procedure TForm1.IconMouse(var Msg:TMessage);
Var p:tpoint;
begin
 GetCursorPos(p); // Запоминаем координаты курсора мыши
 Case Msg.LParam OF  // Проверяем какая кнопка была нажата
  WM_LBUTTONUP,WM_LBUTTONDBLCLK: {Действия, выполняемый по одинарному или двойному щелчку левой кнопки мыши на значке. В нашем случае это просто активация приложения}
                   Begin
                    Ic(2,Application.Icon);  // Удаляем значок из трея
                    ShowWindow(Application.Handle,SW_SHOW); // Восстанавливаем кнопку программы
                    ShowWindow(Handle,SW_SHOW); // Восстанавливаем окно программы
                    Update;
                   End;
  WM_RBUTTONUP: {Действия, выполняемый по одинарному щелчку правой кнопки мыши}
   Begin
    SetForegroundWindow(Handle);  // Восстанавливаем программу в качестве переднего окна
    pmTreyMenu.Popup(p.X,p.Y);  // Заставляем всплыть наше PopMenu
    PostMessage(Handle,WM_NULL,0,0);
   end;
 End;
end;

Procedure TForm1.OnMinimizeProc(Sender:TObject);
Begin
 PostMessage(Handle,WM_SYSCOMMAND,SC_MINIMIZE,0);
End;

Procedure TForm1.ControlWindow(Var Msg:TMessage);
Begin
 IF Msg.WParam=SC_MINIMIZE then
  Begin
   Ic(1,Application.Icon);                    // Добавляем значок в трей
   ShowWindow(Handle,SW_HIDE);                // Скрываем программу
   ShowWindow(Application.Handle,SW_HIDE);  // Скрываем кнопку с TaskBar'а
 End
 else inherited;
End;

Procedure TForm1.Ic(n:Integer;Icon:TIcon);
Var Nim:TNotifyIconData;
begin
 With Nim do
  Begin
   cbSize:=SizeOf(Nim);
   Wnd:=Self.Handle;
   uID:=1;
   uFlags:=NIF_ICON or NIF_MESSAGE or NIF_TIP;
   hicon:=Icon.Handle;
   uCallbackMessage:=wm_user+1;
   szTip :='PC Off';
  End;
 Case n OF
  1: Shell_NotifyIcon(Nim_Add,@Nim);
  2: Shell_NotifyIcon(Nim_Delete,@Nim);
  3: Shell_NotifyIcon(Nim_Modify,@Nim);
 End;
end;
procedure TForm1.N1Click(Sender: TObject);
begin
 ShowMessage('Автор : Gudzik');
end;

procedure TForm1.N2Click(Sender: TObject);
begin
  Ic(2,Application.Icon);
Close;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
Label1.Caption:=FormatDateTime('hh:nn:ss', Time); //Время
end;

procedure TForm1.FormCreate(Sender: TObject);
const
   MOD_ALT = 1;
   MOD_CONTROL = 2;
   MOD_SHIFT = 4;
   MOD_WIN = 8;
   VK_F10 = 121;
   VK_F11 = 122;
   VK_F12 = 123;
Var x:Word;

begin
  PostMessage(Application.Handle, WM_SYSCOMMAND, SC_MINIMIZE, 0);
  chas := StrToTime('00:00:00');
  sec:= StrToTime('0:0:1');

  

  // Register Hotkey Ctrl + Alt + F10
  id1 := GlobalAddAtom('Hotkey1');
   RegisterHotKey(Handle, id1, MOD_CONTROL + MOD_Alt, VK_F10);
 
   // Register Hotkey Ctrl + Alt + F11
  id2 := GlobalAddAtom('Hotkey2');
   RegisterHotKey(Handle, id2, MOD_CONTROL + MOD_Alt, VK_F11);
 
   // Register Hotkey Win + F4 
  id3 := GlobalAddAtom('Hotkey3');
   RegisterHotKey(Handle, id3, MOD_CONTROL + MOD_Alt, VK_F12);
 
   // Globally trap the Windows system key "PrintScreen" 
  id4 := GlobalAddAtom('Hotkey4');
   RegisterHotKey(Handle, id4, 0, VK_SNAPSHOT);
   


Label2.Caption:=DateTostr(Date);
x:= DayOfWeek(Date);
  Case x of
  1: Label7.Caption:='воскресенье';
  2: Label7.Caption:='понедельник';
  3: Label7.Caption:='вторник';
  4: Label7.Caption:='среда';
  5: Label7.Caption:='четверг';
  6: Label7.Caption:='пятница';
  7: Label7.Caption:='суббота';
end;
end;

procedure TForm1.WMHotKey(var Msg: TWMHotKey);
begin
 If Msg.HotKey = id1 then //CTRL+ALT+F10
    begin
      If IsWindowVisible(Self.Handle) then
       begin
        PostMessage(Handle, WM_SYSCOMMAND, SC_MINIMIZE, 1);
        Form3.Close;
        end

      else
       begin
        PostMessage(Handle, WM_User + 1, 1, WM_LBUTTONUP);
        Form3.Close;

        end
    end
  else if Msg.HotKey = id2 then   //  CTRL+ALT+F11
    begin
     Timer2.Enabled:=True ;
     PostMessage(Handle, WM_User + 1, 1, WM_LBUTTONUP);
     chas:=Chas+StrToTime('00:00:35');
     Form3.Close;
     
     end
   else if Msg.HotKey = id3 then  //  CTRL+ALT+F12
   begin
    chas := StrToTime('00:00:00');
    Timer2.Enabled:=False ;
    Label3.Caption:=AddNull(TimeToStr(Chas));
    Form3.Close;
    end





     end;

 // else if Msg.HotKey = id4 then
   // ShowMessage('Print Screen pressed !');
//end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin

  chas:=Chas-sec;
  Label3.Caption:=AddNull(TimeToStr(Chas));
  if TimeToStr(Chas)='0:00:00' then
  begin
    Timer2.Enabled:=False ;
    MyExitWindows(EWX_POWEROFF or EWX_FORCE);
  {ShowMessage('таймер остоновлен !');}

  end
  else
   if TimeToStr(Chas)='0:00:30' then
   begin
     Form3.Label2.Caption:=AddNull(TimeToStr(Chas));
       if (not Assigned(Form3)) then   // проверка существования Формы (если нет, то
       Form3:=TForm3.Create(Self);    // создание Формы)
   Form3.Show; // (или Form2.ShowModal) показ Формы ;
   end;
end;

function TForm1.AddNull(InpTime: String): String;
var S: String;
begin
 S := InpTime;
  if Pos(':', S) - 2 <> 0 then
    Result := S
  else
    begin
      Insert('0', S, 1);
      Result := S
    end;
end;

function TForm1.MyExitWindows(RebootParam: Longword): Boolean;
 var
  TTokenHd: THandle;  
  TTokenPvg: TTokenPrivileges;  
  cbtpPrevious: DWORD;  
  rTTokenPvg: TTokenPrivileges;  
  pcbtpPreviousRequired: DWORD;  
  tpResult: Boolean;  
const
  SE_SHUTDOWN_NAME = 'SeShutdownPrivilege';
begin
 if Win32Platform = VER_PLATFORM_WIN32_NT then  
  begin  
    tpResult := OpenProcessToken(GetCurrentProcess(),  
      TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,  
      TTokenHd);  
    if tpResult then  
    begin  
      tpResult := LookupPrivilegeValue(nil,
                                       SE_SHUTDOWN_NAME,
                                       TTokenPvg.Privileges[0].Luid);  
      TTokenPvg.PrivilegeCount := 1;  
      TTokenPvg.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;  
      cbtpPrevious := SizeOf(rTTokenPvg);
      pcbtpPreviousRequired := 0;  
      if tpResult then  
        Windows.AdjustTokenPrivileges(TTokenHd,  
                                      False,  
                                      TTokenPvg,  
                                      cbtpPrevious, 
                                      rTTokenPvg, 
                                      pcbtpPreviousRequired); 
    end; 
  end; 
  Result := ExitWindowsEx(RebootParam, 0);
end;

procedure TForm1.N4Click(Sender: TObject);
begin
 ShowMessage('Покозать\скрыть программу    CTRL+ALT+F10'+ #13#10 +'Добавить 10мин к таймеру        CTRL+ALT+F11'+ #13#10 +'сбросить время таймера            CTRL+ALT+F12');
end;

procedure TForm1.N3Click(Sender: TObject);
begin
 if (not Assigned(Form2)) then   // проверка существования Формы (если нет, то
       Form2:=TForm2.Create(Self);    // создание Формы)
   Form2.Show; // (или Form2.ShowModal) показ Формы
end;

end.

мне почему то кажется что с добавлением программы в авто загрузку я чёт не так сделал