traybaricon.pas

机房管理系统 是用VB设计的简单的管理系统

        MouseUp(mbMiddle, Shift, Pt.X, Pt.Y);
      end;

    WM_LBUTTONDBLCLK:
      if FEnabled then
      begin
        DblClick;
        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
    case Msg.Msg of
      WM_QUERYENDSESSION: Msg.Result := 1;
    else
      Msg.Result := DefWindowProc(IconData.Wnd, Msg.Msg, Msg.wParam, Msg.lParam);
    end;
end;


procedure TTrayIcon.SetIcon(Value: TIcon);
begin
  // 设置图标
  FIcon.Assign(Value);
  ModifyIcon;
end;


procedure TTrayIcon.SetIconVisible(Value: Boolean);
begin
  // 设置是否显示图标
  if Value then
    ShowIcon
  else
    HideIcon;
end;


procedure TTrayIcon.SetDesignPreview(Value: Boolean);
begin
  // 设置是否预览图标
  FDesignPreview := Value;
  SettingPreview := True;
  SetIconVisible(Value);
  SettingPreview := False;
end;


procedure TTrayIcon.SetCycleIcons(Value: Boolean);
begin
  // 设置是否动态显示图标
  FCycleIcons := Value;
  if Value then
    IconIndex := 0;
  CycleTimer.Enabled := Value;
end;


procedure TTrayIcon.SetCycleInterval(Value: Cardinal);
begin
  // 设置动态图标的更换时间间隔
  FCycleInterval := Value;
  CycleTimer.Interval := FCycleInterval;
end;


procedure TTrayIcon.SetHint(Value: String);
begin
  // 设置要显示的提示信息
  FHint := Value;
  ModifyIcon;
end;


procedure TTrayIcon.SetShowHint(Value: Boolean);
begin
  // 设置是否显示提示
  FShowHint := Value;
  ModifyIcon;
end;


function TTrayIcon.InitIcon: Boolean;
var
  ok: Boolean;
begin
  // 初始化图标
  Result := False;
  ok := True;
  if (csDesigning 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))
    else
      IconData.szTip := '';
    Result := True;
  end;
end;


function TTrayIcon.ShowIcon: Boolean;
begin
  Result := False;
  // 如果没有设置图标预览，则显示图标
  if not SettingPreview then
    FIconVisible := True;
  if (csDesigning 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;


function TTrayIcon.HideIcon: Boolean;
begin
  Result := False;
  // 如果没有设置图标预览，则隐藏图标
  if not SettingPreview then
    FIconVisible := False;
  if (csDesigning 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;


function TTrayIcon.ModifyIcon: Boolean;
begin
  Result := False;
  // 设置托盘图标操作
  if InitIcon then
    Result := Shell_NotifyIcon(NIM_MODIFY, @IconData);
end;


procedure TTrayIcon.TimerCycle(Sender: TObject);
begin
  // 循环更改图标
  if Assigned(FIconList) then
  begin
    FIconList.GetIcon(IconIndex, FIcon);
    CycleIcon;
    ModifyIcon;

    if IconIndex < FIconList.Count-1 then
      Inc(IconIndex)
    else
      IconIndex := 0;
  end;
end;


procedure TTrayIcon.ShowMainForm;
var
  I, J: Integer;
begin
  // 恢复程序
  ShowWindow(Application.Handle, SW_RESTORE);
  // 恢复主窗体
  ShowWindow(Application.MainForm.Handle, SW_RESTORE);

  if not HasShown then
  begin
    for I := 0 to Application.MainForm.ComponentCount -1 do
      if Application.MainForm.Components[I] is TWinControl then
        with Application.MainForm.Components[I] as TWinControl do
          if Visible then
          begin
            ShowWindow(Handle, SW_SHOWDEFAULT);
            for J := 0 to ComponentCount -1 do
              if Components[J] is TWinControl then
                ShowWindow((Components[J] as TWinControl).Handle, SW_SHOWDEFAULT);
          end;
    HasShown := True;
  end;
end;


procedure TTrayIcon.HideMainForm;
begin
  //显示程序
  ShowWindow(Application.Handle, SW_HIDE);
  //显示主窗体
  ShowWindow(Application.MainForm.Handle, SW_HIDE);
end;


procedure TTrayIcon.Refresh;
begin
  ModifyIcon;
end;


procedure TTrayIcon.PopupAtCursor;
var
  CursorPos: TPoint;
begin
  // 如果指定了弹出菜单，则
  if Assigned(PopupMenu) then
    // 如果是设置了自动弹出，则
    if PopupMenu.AutoPopup then
      if GetCursorPos(CursorPos) then
      begin
        // 让应用程序处理当前的消息
        Application.ProcessMessages;
        // 设应用程序主窗体为当前焦点窗体
        SetForegroundWindow(Application.MainForm.Handle);
        PopupMenu.PopupComponent := Self;
        // 显示弹出菜单
        PopupMenu.Popup(CursorPos.X, CursorPos.Y);
        // 发出消息
        PostMessage(Application.MainForm.Handle, WM_NULL, 0, 0);
      end;
end;


procedure TTrayIcon.Click;
begin
  if Assigned(FOnClick) then
    FOnClick(Self);
end;


procedure TTrayIcon.DblClick;
begin
  if Assigned(FOnDblClick) then
    FOnDblClick(Self);
end;


procedure TTrayIcon.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  if Assigned(FOnMouseDown) then
    FOnMouseDown(Self, Button, Shift, X, Y);
end;


procedure TTrayIcon.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  if Assigned(FOnMouseUp) then
    FOnMouseUp(Self, Button, Shift, X, Y);
end;


procedure TTrayIcon.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  if Assigned(FOnMouseMove) then
    FOnMouseMove(Self, Shift, X, Y);
end;


procedure TTrayIcon.CycleIcon;
begin
  if Assigned(FOnCycle) then
    FOnCycle(Self, IconIndex);  //显示下一个图标
end;


procedure TTrayIcon.DoMinimizeToTray;
begin
  // 隐藏主窗体
  HideMainForm;
  // 显示图标
  IconVisible := True;
end;


procedure Register;
begin
  //注册到组件库中
  RegisterComponents('Wuqiu', [TTrayIcon]);
end;

end.