sptrayicon.pas

DynamicSkinForm.v9.15.For.Delphi.BCB 很好的皮肤控件

  then
    begin
      if FEnabled then
        case Msg.lParam of
           NIN_BALLOONUSERCLICK:
             begin
               if Assigned(FOnBalloonHintClick)
               then
                 FOnBalloonHintClick(Self);
             end;
           WM_MOUSEMOVE:
             begin
               Shift := ShiftState;
               GetCursorPos(Pt);
               MouseMove(Shift, Pt.X, Pt.Y);
             end;

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

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

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

           WM_LBUTTONUP:
             begin
               Shift := ShiftState + [ssLeft];
               GetCursorPos(Pt);
               if FClickStart then FClickReady := True;
               if FClickStart and (not ClickTimer.Enabled)
               then
                 begin
                   FClickStart := False;
                   FClickReady := False;
                    Click;
                 end;
               FClickStart := False;
               MouseUp(mbLeft, Shift, Pt.X, Pt.Y);
             end;

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

           WM_MBUTTONUP:
             begin
               Shift := ShiftState + [ssMiddle];
               GetCursorPos(Pt);
               MouseUp(mbMiddle, Shift, Pt.X, Pt.Y);
             end;
           WM_LBUTTONDBLCLK:
             begin
               FClickReady := False;
               IsDblClick := True;
               DblClick;
               M := nil;
               if Assigned(FPopupMenu)
               then
                 if (FPopupMenu.AutoPopup) and (not FPopupByLeftButton)
                 then
                   for I := PopupMenu.Items.Count -1 downto 0 do
                     if PopupMenu.Items[I].Default then M := PopupMenu.Items[I];
               if M <> nil then M.Click;
             end;
        end;
    end
  else
    case Msg.Msg of
      WM_QUERYENDSESSION, WM_CLOSE, WM_QUIT,
      WM_DESTROY, WM_NCDESTROY, WM_USERCHANGED:  Msg.Result := 1;
    else
      Msg.Result := DefWindowProc(IconData.Wnd, Msg.Msg, Msg.wParam, Msg.lParam);
    end;
end;

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

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


procedure TspTrayIcon.SetDesignPreview(Value: Boolean);
begin
  FDesignPreview := Value;
  SettingPreview := True;
  SetIconVisible(Value);
  SettingPreview := False;
end;


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


procedure TspTrayIcon.SetAnimateTimerInterval(Value: Cardinal);
begin
  FAnimateTimerInterval := Value;
  AnimateTimer.Interval := FAnimateTimerInterval;
end;


procedure TspTrayIcon.SetIconList(Value: TImageList);
begin
  FIconList := Value;
  SetIconIndex(0);
end;


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

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

function TspTrayIcon.InitIcon: Boolean;
var
  B: Boolean;
begin
  Result := False;
  B := True;
  if (csDesigning in ComponentState)
  then
    begin
      if SettingPreview then B := True else B := FDesignPreview
    end;
  if B
  then
    begin
      IconData.hIcon := FIcon.Handle;
      if (FHint <> '') and (FShowHint)
      then
        StrLCopy(IconData.szTip, PChar(FHint), SizeOf(IconData.szTip) - 1)
      else
        IconData.szTip := '';
      Result := True;
    end;
end;

function TspTrayIcon.ShowIcon: Boolean;
begin
  Result := False;
  if not SettingPreview then FIconVisible := True;
  if (csDesigning in ComponentState)
  then
    begin
      if SettingPreview and InitIcon
      then Result := Shell_NotifyIcon(NIM_ADD, @IconData);
    end
  else
    if InitIcon then Result := Shell_NotifyIcon(NIM_ADD, @IconData);
end;


function TspTrayIcon.HideIcon: Boolean;
begin
  Result := False;
  if not SettingPreview then FIconVisible := False;
  if (csDesigning in ComponentState)
  then
    begin
      if SettingPreview and InitIcon
      then Result := Shell_NotifyIcon(NIM_DELETE, @IconData);
    end
  else
    if InitIcon then Result := Shell_NotifyIcon(NIM_DELETE, @IconData);
end;

function TspTrayIcon.ModifyIcon: Boolean;
begin
  Result := False;
  if InitIcon then Result := Shell_NotifyIcon(NIM_MODIFY, @IconData);
end;

procedure TspTrayIcon.TimerCycle(Sender: TObject);
begin
  if Assigned(FIconList)
  then
    begin
      FIconList.GetIcon(FIconIndex, FIcon);
      CycleIcon;
      ModifyIcon;
      if FIconIndex < FIconList.Count-1
      then
        SetIconIndex(FIconIndex+1)
      else
        SetIconIndex(0);
    end;
end;

function TspTrayIcon.BitmapToIcon(const Bitmap: TBitmap;
  const Icon: TIcon; MaskColor: TColor): Boolean;
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 TspTrayIcon.Refresh: Boolean;
begin
  Result := ModifyIcon;
end;


procedure TspTrayIcon.PopupAtCursor;
var
  CursorPos: TPoint;
begin
  if Assigned(PopupMenu)
  then
    if PopupMenu.AutoPopup
    then
      if GetCursorPos(CursorPos)
      then
        begin
          Application.ProcessMessages;
          SetForegroundWindow(Handle);
          if Owner is TWinControl then
           SetForegroundWindow((Owner as TWinControl).Handle);
          PopupMenu.PopupComponent := Self;
          PopupMenu.Popup(CursorPos.X, CursorPos.Y);
          if Owner is TWinControl then
          PostMessage((Owner as TWinControl).Handle, WM_NULL, 0, 0);
        end;
end;


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

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

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

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


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


procedure TspTrayIcon.CycleIcon;
var
  NextIconIndex: Integer;
begin
  NextIconIndex := 0;
  if FIconList <> nil then
    if FIconIndex < FIconList.Count then
      NextIconIndex := FIconIndex +1;
  if Assigned(FOnCycle) then
    FOnCycle(Self, NextIconIndex);
end;


procedure TspTrayIcon.DoMinimizeToTray;
begin
  HideMainForm;
  IconVisible := True;
end;


procedure TspTrayIcon.TimerClick(Sender: TObject);
begin
  ClickTimer.Enabled := False;
  if (not IsDblClick)
  then
    if FClickReady
    then
      begin
        FClickReady := False;
        Click;
      end;
  IsDblClick := False;
end;


procedure TspTrayIcon.ShowMainForm;
begin
  if Owner is TWinControl then
    if Application.MainForm <> nil
    then
      begin
        ShowWindow(Application.Handle, SW_RESTORE);
        Application.MainForm.Visible := True;
        if Application.MainForm.WindowState = wsMinimized
        then Application.MainForm.WindowState := wsNormal;
      end;
end;

procedure TspTrayIcon.HideMainForm;
begin
  if Owner is TWinControl
  then
    if Application.MainForm <> nil
    then
      begin
        Application.MainForm.Visible := False;
        ShowWindow(Application.Handle, SW_HIDE);
      end;
end;

function TspTrayIcon.ShowBalloonHint;
const
  aBalloonIconTypes: array[TspBalloonHintIcon] of Byte =
    (NIIF_NONE, NIIF_INFO, NIIF_WARNING, NIIF_ERROR);
begin
  HideBalloonHint;
  with IconData do
  begin
    uFlags := uFlags or NIF_INFO;
    StrLCopy(szInfo, PChar(Text), SizeOf(szInfo)-1);
    StrLCopy(szInfoTitle, PChar(Title), SizeOf(szInfoTitle)-1);
    dwInfoFlags := aBalloonIconTypes[IconType];
  end;
  Result := ModifyIcon;
  with IconData do
    uFlags := NIF_ICON + NIF_MESSAGE + NIF_TIP;
end;


function TspTrayIcon.HideBalloonHint: Boolean;
begin
  with IconData do
  begin
    uFlags := uFlags or NIF_INFO;
    StrPCopy(szInfo, '');
  end;
  Result := ModifyIcon;
end;

end.