CHAT.MD

Код: Выделить всё

program MyCD;
uses
  Windows,
  Messages,
  ShellAPI,
  MMSystem;

{$R *.RES}

const
  szTrayTip:PChar='LMB- открыть, RMB- закрыть';
  WM_NOTIFYICON = WM_USER + 1;

var
  hMainWnd: HWND;
  MyNotifyIconData: TNotifyIconData;
  OpenParm: TMCI_Open_Parms;
  GenParm: TMCI_Generic_Parms;
  SetParm: TMCI_Set_Parms;
  DI : Cardinal;

procedure Eject;
begin
  OpenParm.lpstrDeviceType := 'CDAudio';
  mciSendCommand(0, mci_Open, mci_Open_Type, Longint(@OpenParm));
  DI := OpenParm.wDeviceID;
  mciSendCommand(DI, mci_Set, mci_Set_Door_Open, Longint(@SetParm));
end;

procedure Close;
begin
  mciSendCommand(DI, mci_Set, mci_Set_Door_Closed, Longint(@SetParm));
  mciSendCommand(DI, mci_Close, mci_Notify, Longint(@GenParm));
end;

function MainWndProc(Window: HWND; Message: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
  Result := 0;
  case Message of
    WM_NOTIFYICON: if (lParam = WM_LBUTTONDOWN)
                   then
                     Eject
                   else
                     if (lParam = WM_RBUTTONDOWN)
                     then Close;
    else
      Result:= DefWindowProc(Window, Message, wParam, lParam);
  end;
end;

var
  hMainWndClass: TWndClass =
  (
    style: 0;
    lpfnWndProc: @MainWndProc;
    cbClsExtra: 0;
    cbWndExtra: 0;
    hInstance: 0;
    hIcon: 0;
    hCursor: 0;
    hbrBackground: 0;
    lpszMenuName: nil;
    lpszClassName: 'MANMON WND'
  );

function CreateMainWnd: Boolean;
begin
  hMainWndClass.hInstance:= HInstance;
  RegisterClass(hMainWndClass);
  hMainWnd:= CreateWindow(hMainWndClass.lpszClassName, '', 0, 0, 0, 0, 0, 0, 0, HInstance, nil);
  Result:= hMainWnd <> 0;
end;

function PlaceInTray: Boolean;
begin
  with MyNotifyIconData do
  begin
    cbSize:= SizeOf(MyNotifyIconData);
    Wnd:=hMainWnd;
    uID:=0;
    uFlags:= NIF_MESSAGE + NIF_ICON + NIF_TIP;
    uCallbackMessage:= WM_NOTIFYICON;
    hIcon:= LoadIcon(HInstance, 'MAINICON');
    lstrcpyn(szTip, PChar(szTrayTip), SizeOf(szTip));
  end;
  Result:= Shell_NotifyIcon(NIM_ADD, @MyNotifyIconData);
end;

procedure HandleMessage;
var
  Msg: TMsg;
begin
  while GetMessage(Msg, 0, 0, 0) do
  begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;
end;

function InstanceExist: Boolean;
begin
  Result:= FindWindow(hMainWndClass.lpszClassName, nil) <> 0;
end;

begin
  if not InstanceExist and CreateMainWnd then
  begin
    if PlaceInTray then
    begin
      HandleMessage;
      Shell_NotifyIcon(NIM_DELETE, @MyNotifyIconData);
    end;
    DestroyWindow(hMainWnd);
  end;
end.