hwtrayicon.pas.svn-base

这是一个功能齐全的,代码完整的ERP企业信息管理系统,现在上传和大家分享

          FClickStart := True;
          if FLeftPopup then
            PopupAtCursor;
        end;

      WM_RBUTTONDOWN:
        if FEnabled then
        begin
          Shift := ShiftState + [ssRight];
          GetCursorPos(Pt);
          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
      { 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
//showmessage('WM_QUERYENDSESSION');
//        PostQuitMessage(0);
        Msg.Result := 1;
      end;
{
      WM_DESTROY: begin
showmessage('WM_DESTROY');
        PostQuitMessage(0);
        Msg.Result := 0;
      end;
}
{
      WM_ENDSESSION: begin
//showmessage('WM_ENDSESSION');
        Msg.Result := 0;
      end;
}
    else      // Handle all other messages with the default handler
      Msg.Result := DefWindowProc(IconData.Wnd, Msg.Msg, Msg.wParam, Msg.lParam);
    end;
end;

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

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

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

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

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

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

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

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

function THwTrayIcon.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)-1)
      // StrLCopy must be used since szTip is only 64 bytes
    else
      IconData.szTip := '';
    Result := True;
  end;
end;

function THwTrayIcon.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 THwTrayIcon.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 THwTrayIcon.ModifyIcon: Boolean;
// Change icon or tooltip if icon already placed
begin
  Result := False;
  if InitIcon then
    Result := Shell_NotifyIcon(NIM_MODIFY, @IconData);
end;

procedure THwTrayIcon.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 THwTrayIcon.ShowMainForm;
begin
  if Application.MainForm <> nil then
  begin
    // Show application's TASKBAR icon (not the traybar icon)
    ShowWindow(Application.Handle, SW_RESTORE);
//    ShowWindow(Application.Handle, SW_SHOWNORMAL);
//    Application.Restore;
    // Show the form itself
    Application.MainForm.Visible := True;
//    ShowWindow((Owner as TWinControl).Handle, SW_RESTORE);
  end;
end;

procedure THwTrayIcon.HideMainForm;
begin
  if Application.MainForm <> nil then
  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;
end;

function THwTrayIcon.ShowBalloonHint(Title: String; Text: String;
  IconType: TBalloonHintIcon; TimeoutSecs: TBalloonHintTimeOut): Boolean;
// Show balloon hint. Return false if error.
const
  aBalloonIconTypes: array[TBalloonHintIcon] of Byte =
    (NIIF_NONE, NIIF_INFO, NIIF_WARNING, NIIF_ERROR);
begin
  if FEnabled then
  begin
    // Remove old balloon hint
    with IconData do
    begin
      uFlags := uFlags or NIF_INFO;
      StrPCopy(szInfo, '');
    end;
    ModifyIcon;
    // Display new balloon hint
    with IconData do
    begin
      uFlags := uFlags or NIF_INFO;
      StrPCopy(szInfo, Text);
      StrPCopy(szInfoTitle, Title);
      uTimeout := TimeoutSecs * 1000;
      dwInfoFlags := aBalloonIconTypes[IconType];
    end;
    Result := ModifyIcon;
    { Remove NIF_INFO before next call to ModifyIcon (or else the balloon hint
      will redisplay itself) }
    with IconData do
      uFlags := NIF_ICON + NIF_MESSAGE + NIF_TIP;
  end
  else
    Result := True;
end;

function THwTrayIcon.BitmapToIcon(const Bitmap: TBitmap;
  const Icon: TIcon; MaskColor: TColor): Boolean;
{ Render an icon from a 16x16 bitmap. Return false if error.
  MaskColor is a color that will be rendered transparently. Use clNone for
  no transparency. }
var
  BitmapImageList: TImageList;
begin
  BitmapImageList := TImageList.CreateSize(16, 16);
  try
    Result := False;
    BitmapImageList.AddMasked(Bitmap, MaskColor);
    BitmapImageList.GetIcon(0, Icon);
    Result := True;
  finally
    BitmapImageList.Free;
  end;
end;

function THwTrayIcon.Refresh: Boolean;
// Refresh the icon
begin
  Result := ModifyIcon;
end;

procedure THwTrayIcon.PopupAtCursor;
var
  CursorPos: TPoint;
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 in succession). 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. }
        SetForegroundWindow((Owner as TWinControl).Handle);
{
This seems unnecessary(?):
        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);
        // Post an empty message to make the popup menu disappear
        PostMessage((Owner as TWinControl).Handle, WM_NULL, 0, 0);
      end;
end;

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

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

procedure THwTrayIcon.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 THwTrayIcon.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 THwTrayIcon.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  // Execute user-assigned method
  if Assigned(FOnMouseMove) then
    FOnMouseMove(Self, Shift, X, Y);
end;

procedure THwTrayIcon.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 THwTrayIcon.DoMinimizeToTray;
begin
  // Override this method to change automatic tray minimizing behavior
  HideMainForm;
  IconVisible := True;
end;

end.