cooltrayicon.pas

絮语2007视频聊天软件源程序.仅供参考

  if Assigned(NewAppProc) then
    FreeObjectInstance(NewAppProc);
  NewAppProc := nil;
  OldAppProc := nil;
end;


{ All app. messages pass through HookAppProc. You can override the
  messages by not passing them along to Windows (via CallWindowProc). }

procedure TCoolTrayIcon.HookAppProc(var Msg: TMessage);
begin
  case Msg.Msg of

    WM_SIZE:
      // Handle MinimizeToTray by capturing app's minimize events
      if Msg.wParam = SIZE_MINIMIZED then
      begin
        if FMinimizeToTray then
          DoMinimizeToTray;
        { You could insert a call to a custom minimize event here, but it
          would behave exactly like Application.OnMinimize, so I see no
          need for it. }
      end;

    WM_WINDOWPOSCHANGED: begin
      { Handle MDI forms (MDI children cause app. to be redisplayed on
        taskbar. We hide it again. This may cause a quick flicker (?)). }
      if SettingMDIForm then
        if Application.MainForm <> nil then
        begin
          if Application.MainForm.FormStyle = fsMDIForm then
            if FStartMinimized then
              ShowWindow(Application.Handle, SW_HIDE);
          SettingMDIForm := False;   // So we only do this once
        end;
    end;

  end;

  { Show the tray icon if the taskbar has been re-created after an
    Explorer crash. }
  if Msg.Msg = WM_TASKBARCREATED then
    if FIconVisible then
      ShowIcon;

  // Pass the message on
  Msg.Result := CallWindowProc(OldAppProc, Application.Handle,
                Msg.Msg, Msg.wParam, Msg.lParam);
end;


{ You can hook into the main form (or any other window) just as easily
  as hooking into the app., allowing you to handle any message that
  window processes.
  This is necessary in order to properly handle when the user minimizes
  the form using the TASKBAR icon. }

procedure TCoolTrayIcon.HookForm;
begin
  if (Owner as TWinControl) <> nil then
  begin
    // Hook the parent window
    OldWndProc := Pointer(GetWindowLong((Owner as TWinControl).Handle, GWL_WNDPROC));
    NewWndProc := MakeObjectInstance(HookFormProc);
    SetWindowLong((Owner as TWinControl).Handle, GWL_WNDPROC, LongInt(NewWndProc));
  end;
end;


procedure TCoolTrayIcon.UnhookForm;
begin
  if ((Owner as TWinControl) <> nil) and (Assigned(OldWndProc)) then
    SetWindowLong((Owner as TWinControl).Handle, GWL_WNDPROC, LongInt(OldWndProc));
  if Assigned(NewWndProc) then
    FreeObjectInstance(NewWndProc);
  NewWndProc := nil;
  OldWndProc := nil;
end;

{ All main form messages pass through HookFormProc. You can override the
  messages by not passing them along to Windows (via CallWindowProc).
  You should be careful with the graphical messages, though. }

procedure TCoolTrayIcon.HookFormProc(var Msg: TMessage);
begin
  case Msg.Msg of

    WM_SHOWWINDOW: begin
      if (Msg.lParam = 0) and (Msg.wParam = 1) then
      begin
        // Show the taskbar icon (Windows may have shown it already)
        ShowWindow(Application.Handle, SW_RESTORE);
        // Bring the taskbar icon and the main form to the foreground
        SetForegroundWindow(Application.Handle);
        SetForegroundWindow((Owner as TWinControl).Handle);
      end;
    end;
{
    WM_WINDOWPOSCHANGED: begin
      // Bring any modal forms owned by the main form to the foreground
      if Assigned(Screen.ActiveControl) then
        SetFocus(Screen.ActiveControl.Handle);
    end;
}
    WM_ACTIVATE: begin
      // Bring any modal forms owned by the main form to the foreground
      if Assigned(Screen.ActiveControl) then
        if (Msg.WParamLo = WA_ACTIVE) or (Msg.WParamLo = WA_CLICKACTIVE) then
          if Assigned(Screen.ActiveControl.Parent) then
          begin
            // Control on modal form is active
            if HWND(Msg.lParam) <> Screen.ActiveControl.Parent.Handle then
              SetFocus(Screen.ActiveControl.Handle);
          end
          else
          begin
            // Modal form itself is active
            if HWND(Msg.lParam) <> Screen.ActiveControl.Handle then
              SetFocus(Screen.ActiveControl.Handle);
          end;
    end;

  end;
  // Pass the message on
  Msg.Result := CallWindowProc(OldWndProc, (Owner as TWinControl).Handle,
                Msg.Msg, Msg.wParam, Msg.lParam);
end;


{ HandleIconMessage handles messages that go to the shell notification
  window (tray icon) itself. Most messages are passed through WM_TRAYNOTIFY.
  In these cases use lParam to get the actual message, eg. WM_MOUSEMOVE.
  The method sends the usual Delphi events for the mouse messages. It also
  interpolates the OnClick event when the user clicks the left button, and
  makes the menu (if any) popup on left and right mouse down events. }

procedure TCoolTrayIcon.HandleIconMessage(var Msg: TMessage);

  function ShiftState: TShiftState;
  // Return the state of the shift, ctrl, and alt keys
  begin
    Result := [];
    if GetAsyncKeyState(VK_SHIFT) < 0 then
      Include(Result, ssShift);
    if GetAsyncKeyState(VK_CONTROL) < 0 then
      Include(Result, ssCtrl);
    if GetAsyncKeyState(VK_MENU) < 0 then
      Include(Result, ssAlt);
  end;

var
  Pt: TPoint;
  Shift: TShiftState;
//  I: Integer;
//  M: TMenuItem;
begin
  if Msg.Msg = WM_TRAYNOTIFY then
  // Take action if a message from the icon comes through
  begin
    case Msg.lParam of

      WM_MOUSEMOVE:
        if FEnabled then
        begin
          Shift := ShiftState;
          GetCursorPos(Pt);
          MouseMove(Shift, Pt.X, Pt.Y);
        end;

      WM_LBUTTONDOWN:
        if FEnabled then
        begin
          Shift := ShiftState + [ssLeft];
          GetCursorPos(Pt);
          MouseDown(mbLeft, Shift, Pt.X, Pt.Y);
          FClickStart := True;
          Ftimers.Enabled:=true;
        end;

      WM_RBUTTONDOWN:
        if FEnabled then
        begin
          Shift := ShiftState + [ssRight];
          GetCursorPos(Pt);
          MouseDown(mbRight, Shift, Pt.X, Pt.Y);
          PopupAtCursor(false);
        end;

      WM_MBUTTONDOWN:
        if FEnabled then
        begin
          Shift := ShiftState + [ssMiddle];
          GetCursorPos(Pt);
          MouseDown(mbMiddle, Shift, Pt.X, Pt.Y);
        end;

      WM_LBUTTONUP:
        if FEnabled then
        begin
          Shift := ShiftState + [ssLeft];
          GetCursorPos(Pt);
          if FClickStart then       // Then WM_LBUTTONDOWN was called before
          begin
            FClickStart := False;
            Click;                  // We have a click
          end;
          MouseUp(mbLeft, Shift, Pt.X, Pt.Y);
        end;

      WM_RBUTTONUP:
        if FEnabled then
        begin
          Shift := ShiftState + [ssRight];
          GetCursorPos(Pt);
          MouseUp(mbRight, Shift, Pt.X, Pt.Y);
        end;

      WM_MBUTTONUP:
        if FEnabled then
        begin
          Shift := ShiftState + [ssMiddle];
          GetCursorPos(Pt);
          MouseUp(mbMiddle, Shift, Pt.X, Pt.Y);
        end;

      WM_LBUTTONDBLCLK:
        if FEnabled then
        begin
          Ftimers.Enabled:=false;
          DblClick;
          { Handle default menu items. But only if LeftPopup is false,
            or it will conflict with the popupmenu, when it is called
            by a click event. }
       {   M := nil;
          if Assigned(FPopupMenu) then
            if FPopupMenu.AutoPopup then
              for I := PopupMenu.Items.Count -1 downto 0 do
              begin
                if PopupMenu.Items[I].Default then
                  M := PopupMenu.Items[I];
              end;
          if M <> nil then
            M.Click; }
        end;
      end;
  end

  else        // Messages that didn't go through the icon
    case Msg.Msg of
      { Windows sends us a WM_QUERYENDSESSION message when it prepares
        for shutdown. Msg.Result must not return 0, or the system will
        be unable to shut down. }
      WM_QUERYENDSESSION: begin
        Msg.Result := 1;
      end;
    else      // Handle all other messages with the default handler
      Msg.Result := DefWindowProc(IconData.Wnd, Msg.Msg, Msg.wParam, Msg.lParam);
    end;
end;


procedure TCoolTrayIcon.SetIcon(Value: TIcon);
begin
  FIcon.Assign(Value);
  ModifyIcon;
end;


procedure TCoolTrayIcon.SetIconVisible(Value: Boolean);
begin
  if Value then
    ShowIcon
  else
    HideIcon;
end;


procedure TCoolTrayIcon.SetDesignPreview(Value: Boolean);
begin
  FDesignPreview := Value;
  SettingPreview := True;         // Raise flag
  SetIconVisible(Value);
  SettingPreview := False;        // Clear flag
end;


procedure TCoolTrayIcon.SetCycleIcons(Value: Boolean);
begin
  FCycleIcons := Value;
  if Value then
    SetIconIndex(0);
  CycleTimer.Enabled := Value;
end;


procedure TCoolTrayIcon.SetCycleInterval(Value: Cardinal);
begin
  FCycleInterval := Value;
  CycleTimer.Interval := FCycleInterval;
end;


procedure TCoolTrayIcon.SetIconList(Value: TImageList);
begin
  FIconList := Value;
{
  // Set CycleIcons = false if IconList is nil
  if Value = nil then
    SetCycleIcons(False);
}
  SetIconIndex(0);
end;


procedure TCoolTrayIcon.SetIconIndex(Value: Integer);
begin
  if FIconList <> nil then
  begin
    FIconIndex := Value;
    if Value >= FIconList.Count then
      FIconIndex := FIconList.Count -1;
    FIconList.GetIcon(FIconIndex, FIcon);
  end
  else
    FIconIndex := 0;

  ModifyIcon;
end;


procedure TCoolTrayIcon.SetHint(Value: String);
begin
  FHint := Value;
  ModifyIcon;
end;


procedure TCoolTrayIcon.SetShowHint(Value: Boolean);
begin
  FShowHint := Value;
  ModifyIcon;