systray.pas

=== === === MiniHex 1.61 源程序说明 ============================== “$(MiniHex)Source”目录中的所有

      if FAnimateMode = amThread then
      begin
        FAniThread := TTrayAnimateThread.Create(True, Self);
        FAniThread.FreeOnTerminate := True;
        FAniThread.Resume;
      end else
      begin
        FTimer := TTimer.Create(Self);
        FTimer.Interval := FInterval;
        FTimer.OnTimer := Timer;
        FTimer.Enabled := True;
      end;
    end else
    begin
      if FAnimateMode = amThread then
      begin
        FAniThread.Terminate;
      end else
      begin
        FTimer.Free;
        FTimer := nil;
      end;
    end;
    FImageIndex := 0;
    UpdateIcon;
  end;
end;

procedure TSysTray.SetInterval(Value: Word);
begin
  FInterval := Value;
  if FTimer <> nil then
    FTimer.Interval := Value;
end;

procedure TSysTray.SetShowDesigning(Value: Boolean);
begin
  if (csDesigning in ComponentState) then
  begin
    if Value <> FShowDesigning then
    begin
      FShowDesigning := Value;
      case Value of
        True:    UpdateIcon;
        False:   DeleteIcon;
      end;
    end;
  end;
end;

procedure TSysTray.SetImages(Value: TCustomImageList);
begin
  if FImages <> nil then FImages.UnRegisterChanges(FImageChangeLink);
  FImages := Value;
  if FImages <> nil then
  begin
    FImages.RegisterChanges(FImageChangeLink);
    FImages.FreeNotification(Self);
  end;
  //{ TODO :  }
end;

procedure TSysTray.FillDataStructure;
begin
  with FIconData do
  begin
    uCallbackMessage := CM_SYSTRAY;
    cbSize := SizeOf(FIconData);
    uID := IDI_TRAYICON;
    wnd := FHandle;
    hIcon := GetActiveIcon.Handle;
    StrLCopy(FIconData.szTip, PChar(FHint), 63);
    uFlags := NIF_ICON + NIF_TIP + NIF_MESSAGE;
  end;
end;

procedure TSysTray.CheckMenuPopup(Button: TMouseButton; X, Y: Integer);
begin
  if Assigned(FPopupMenu) then
  begin
    if (pmLeftClick in FPopupMode) and (Button = mbLeft) or
       (pmRightClick in FPopupMode) and (Button = mbRight) then
    begin
      SwitchToWindow(FParentWindow, True);
      FPopupMenu.Alignment := FPopupAlign;
      FPopupMenu.Popup(X, Y);
    end;
  end;
end;

function TSysTray.GetActiveIcon: TIcon;
begin
  Result := FIcon;
  if (FImages <> nil) and (FImages.Count > 0) and Animated then
  begin
    if GetIconFromImages(FImageIndex, FCurIcon) then
      Result := FCurIcon
    else if GetIconFromImages(0, FCurIcon) then
      Result := FCurIcon;
  end;
end;

function TSysTray.GetIconFromImages(Index: Integer; Icon: TIcon): Boolean;
begin
  Result := (Index >= 0) and (Index < FImages.Count);
  if Result then FImages.GetIcon(Index, Icon);
end;

procedure TSysTray.ImageListChange(Sender: TObject);
begin
  UpdateIcon;
end;

procedure TSysTray.Timer(Sender: TObject);
begin
  if not (csDestroying in ComponentState) and Animated then
  begin
    Inc(FImageIndex);
    if (FImages = nil) or (FImageIndex >= FImages.Count) then
      FImageIndex := 0;
    UpdateIcon;
  end;
end;

procedure TSysTray.IconChange(Sender: TObject);
begin
  UpdateIcon;
end;

procedure TSysTray.DblClick;
begin
  if Assigned(FOnIconDblClick) then
    FOnIconDblClick(Self);
end;

procedure TSysTray.Click(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Assigned(FOnIconClick) then
    FOnIconClick(Self, Button, Shift, X, Y);
end;

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

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

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

procedure TSysTray.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
  begin
    if AComponent = FPopupMenu then FPopupMenu := nil;
    if AComponent = FImages then Images := nil;
  end;
end;

procedure TSysTray.WndProc(var Message: TMessage);
var
  P: TPoint;
  ShiftState: TShiftState;
begin
  try
    if (Message.Msg = CM_SYSTRAY) and Self.FEnabled then
    begin
      if (Message.WParam = IDI_TRAYICON) then
      begin
        case Message.LParam of
          WM_LBUTTONDBLCLK:
            begin
              GetCursorPos(P);
              DblClick;
              MouseDown(mbLeft, GetShiftState + [ssDouble], P.X, P.Y);
            end;
          WM_RBUTTONDBLCLK:
            begin
              GetCursorPos(P);
              DblClick;
              MouseDown(mbRight, GetShiftState + [ssDouble], P.X, P.Y);
            end;
          WM_MBUTTONDBLCLk:
            begin
              GetCursorPos(P);
              DblClick;
              MouseDown(mbMiddle, GetShiftState + [ssDouble], P.X, P.Y);
            end;
          WM_MOUSEMOVE:
            begin
              GetCursorPos(P);
              MouseMove(GetShiftState, P.X, P.Y);
            end;
          WM_LBUTTONDOWN:
            begin
              GetCursorPos(P);
              Include(FClicked, mbLeft);
              MouseDown(mbLeft, GetShiftState + [ssLeft], P.X, P.Y);
              CheckMenuPopup(mbLeft, P.X, P.Y);
            end;
          WM_LBUTTONUP:
            begin
              GetCursorPos(P);
              ShiftState := GetShiftState;
              if mbLeft in FClicked then
              begin
                Exclude(FClicked, mbLeft);
                Click(mbLeft, ShiftState + [ssLeft], P.X, P.Y);
              end;
              MouseUp(mbLeft, ShiftState + [ssLeft], P.X, P.Y);
            end;
          WM_RBUTTONDOWN:
            begin
              GetCursorPos(P);
              Include(FClicked, mbRight);
              MouseDown(mbRight, GetShiftState + [ssRight], P.X, P.Y);
              CheckMenuPopup(mbRight, P.X, P.Y);
            end;
          WM_RBUTTONUP:
            begin
              GetCursorPos(P);
              ShiftState := GetShiftState;
              if mbRight in FClicked then
              begin
                Exclude(FClicked, mbRight);
                Click(mbRight, ShiftState + [ssRight], P.X, P.Y);
              end;
              MouseUp(mbRight, ShiftState + [ssRight], P.X, P.Y);
            end;
          WM_MBUTTONDOWN:
            begin
              GetCursorPos(P);
              MouseDown(mbMiddle, GetShiftState + [ssMiddle], P.X, P.Y);
            end;
          WM_MBUTTONUP:
            begin
              GetCursorPos(P);
              MouseUp(mbMiddle, GetShiftState + [ssMiddle], P.X, P.Y);
            end;
        end; //case
      end;
    end else
    // 任务栏重建消息
    if Message.Msg = WM_TASKBARCREATED then
    begin
      AddIcon;
    end else
    begin
      Message.Result := DefWindowProc(FHandle, Message.Msg, Message.wParam, Message.lParam);
    end;
  except
    Application.HandleException(Self);
  end;
end;

{ TTrayAnimateThread }

constructor TTrayAnimateThread.Create(CreateSuspended: Boolean; ASysTray: TSysTray);
begin
  FSysTray := ASysTray;
  inherited Create(CreateSuspended);
end;

destructor TTrayAnimateThread.Destroy;
begin
  inherited;
end;

procedure TTrayAnimateThread.Execute;

  function ThreadClosed: Boolean;
  begin
    Result := Terminated or Application.Terminated or (FSysTray = nil);
  end;
  
begin
  while not Terminated do
  begin
    with FSysTray do
    begin
      if not ThreadClosed and not (csDestroying in ComponentState) and Animated then
      begin
        Inc(FImageIndex);
        if (FImages = nil) or (FImageIndex >= FImages.Count) then
          FImageIndex := 0;
        UpdateIcon;
      end;
      Sleep(FInterval);
    end;
  end;
end;

initialization
  WM_TASKBARCREATED := RegisterWindowMessage('TaskbarCreated');

{$WARN SYMBOL_DEPRECATED ON}

end.