lbtrayicon.pas

天涯進銷存系統

        MouseDown(mbRight, Shift, Pt.X, Pt.Y);
        PopupAtCursor;
      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
        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) and (not FLeftPopup) 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
      { Evaluate WM_QUERYENDSESSION message to tell Windows that the
        icon will stop executing if user requests a shutdown (Msg.Result
        must not return 0, or the system will not be able to shut down). }
      WM_QUERYENDSESSION: Msg.Result := 1;
    else      // Handle all other messages with the default handler
      Msg.Result := DefWindowProc(IconData.Wnd, Msg.Msg, Msg.wParam, Msg.lParam);
    end;
end;


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


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


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


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


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


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


procedure TLBTrayIcon.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 TLBTrayIcon.SetHint(Value: String);
begin
  FHint := Value;
  ModifyIcon;
end;


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


function TLBTrayIcon.InitIcon: Boolean;
// Set icon and tooltip
var
  ok: Boolean;
begin
  Result := False;
  ok := True;
  if (csDesigning in ComponentState) {or
     (csLoading in ComponentState)} then
  begin
    if SettingPreview then
      ok := True
    else
      ok := FDesignPreview
  end;

  if ok then
  begin
    IconData.hIcon := FIcon.Handle;
    if (FHint <> '') and (FShowHint) then
      StrLCopy(IconData.szTip, PChar(FHint), SizeOf(IconData.szTip))
      // StrLCopy must be used since szTip is only 64 bytes
    else
      IconData.szTip := '';
    Result := True;
  end;
end;


function TLBTrayIcon.ShowIcon: Boolean;
// Add/show the icon on the tray
begin
  Result := False;
  if not SettingPreview then
    FIconVisible := True;
  begin
    if (csDesigning in ComponentState) {or
     (csLoading in ComponentState)} then
    begin
      if SettingPreview then
        if InitIcon then
          Result := Shell_NotifyIcon(NIM_ADD, @IconData);
    end
    else
    if InitIcon then
      Result := Shell_NotifyIcon(NIM_ADD, @IconData);
  end;
end;


function TLBTrayIcon.HideIcon: Boolean;
// Remove/hide the icon from the tray
begin
  Result := False;
  if not SettingPreview then
    FIconVisible := False;
  begin
    if (csDesigning in ComponentState) {or
     (csLoading in ComponentState)} then
    begin
      if SettingPreview then
        if InitIcon then
          Result := Shell_NotifyIcon(NIM_DELETE, @IconData);
    end
    else
    if InitIcon then
      Result := Shell_NotifyIcon(NIM_DELETE, @IconData);
  end;
end;


function TLBTrayIcon.ModifyIcon: Boolean;
// Change icon or tooltip if icon already placed
begin
  Result := False;
  if InitIcon then
    Result := Shell_NotifyIcon(NIM_MODIFY, @IconData);
end;


procedure TLBTrayIcon.TimerCycle(Sender: TObject);
begin
  if Assigned(FIconList) then
  begin
    FIconList.GetIcon(FIconIndex, FIcon);
    CycleIcon;                    // Call event method
    ModifyIcon;

    if FIconIndex < FIconList.Count-1 then
      SetIconIndex(FIconIndex+1)
    else
      SetIconIndex(0);
  end;
end;


procedure TLBTrayIcon.ShowMainForm;
begin
  // Show application's TASKBAR icon (not the traybar icon)
  ShowWindow(Application.Handle, SW_RESTORE);
//  Application.Restore;
  // Show the form itself
  Application.MainForm.Visible := True;
//  ShowWindow((Owner as TWinControl).Handle, SW_RESTORE);
end;


procedure TLBTrayIcon.HideMainForm;
begin
  // Hide the form itself (and thus any child windows)
  Application.MainForm.Visible := False;
  { Hide application's TASKBAR icon (not the traybar icon).
    Do this AFTER the mainform is hidden, or any child windows
    will redisplay the taskbar icon if they are visible. }
  ShowWindow(Application.Handle, SW_HIDE);
end;


procedure TLBTrayIcon.Refresh;
// Refresh the icon
begin
  ModifyIcon;
end;


procedure TLBTrayIcon.PopupAtCursor;
var
  CursorPos: TPoint;
  I: Integer;
  Found: Boolean;
begin
  if Assigned(PopupMenu) then
    if PopupMenu.AutoPopup then
      if GetCursorPos(CursorPos) then
      begin
        { Win98 (but not Win95/WinNT) seems to empty a popup menu before
          closing it. This is a problem when the menu is about to display
          while it already is active (two click-events following each
          other). The menu will flicker annoyingly.
          Calling ProcessMessages fixes this. }
        Application.ProcessMessages;

        { Bring the main form or its modal dialog to the foreground.
          This also ensures the popup menu closes after it loses focus. }
//        if not (csDesigning in ComponentState) then
          if Screen.ActiveControl <> nil then
            if (Screen.ActiveControl.Owner is TWinControl) then
              SetForegroundWindow((Screen.ActiveControl.Owner as TWinControl).Handle);

        // Now make the menu pop up
        PopupMenu.PopupComponent := Self;
        PopupMenu.Popup(CursorPos.X, CursorPos.Y);
        PostMessage((Owner as TWinControl).Handle, WM_NULL, 0, 0);
      end;
end;


procedure TLBTrayIcon.Click;
begin
  // Execute user-assigned method
  if Assigned(FOnClick) then
    FOnClick(Self);
end;


procedure TLBTrayIcon.DblClick;
begin
  // Execute user-assigned method
  if Assigned(FOnDblClick) then
    FOnDblClick(Self);
end;


procedure TLBTrayIcon.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  // Execute user-assigned method
  if Assigned(FOnMouseDown) then
    FOnMouseDown(Self, Button, Shift, X, Y);
end;


procedure TLBTrayIcon.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  // Execute user-assigned method
  if Assigned(FOnMouseUp) then
    FOnMouseUp(Self, Button, Shift, X, Y);
end;


procedure TLBTrayIcon.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  // Execute user-assigned method
  if Assigned(FOnMouseMove) then
    FOnMouseMove(Self, Shift, X, Y);
end;


procedure TLBTrayIcon.CycleIcon;
var
  NextIconIndex: Integer;
begin
  // Execute user-assigned method
  NextIconIndex := 0;
  if FIconList <> nil then
    if FIconIndex < FIconList.Count then
      NextIconIndex := FIconIndex +1;

  if Assigned(FOnCycle) then
    FOnCycle(Self, NextIconIndex);
end;


procedure TLBTrayIcon.DoMinimizeToTray;
begin
  // Override this method to change automatic tray minimizing behavior
  HideMainForm;
  IconVisible := True;
end;

end.