bstrayicon.pas

漂亮的皮肤控件 for delphi 567

    if GetAsyncKeyState(VK_MENU) < 0
    then Include(Result, ssAlt);
  end;

var
  Pt: TPoint;
  Shift: TShiftState;
  I: Integer;
  M: TMenuItem;
begin
  if Msg.Msg = WM_TRAYNOTIFY
  then
    begin
      if FEnabled then
        case Msg.lParam of
           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 TbsTrayIcon.SetIcon(Value: TIcon);
begin
  FIcon.Assign(Value);
  ModifyIcon;
end;

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


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


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


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


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


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

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

function TbsTrayIcon.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 TbsTrayIcon.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 TbsTrayIcon.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 TbsTrayIcon.ModifyIcon: Boolean;
begin
  Result := False;
  if InitIcon then Result := Shell_NotifyIcon(NIM_MODIFY, @IconData);
end;

procedure TbsTrayIcon.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 TbsTrayIcon.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 TbsTrayIcon.Refresh: Boolean;
begin
  Result := ModifyIcon;
end;


procedure TbsTrayIcon.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 TbsTrayIcon.Click;
begin
  if Assigned(FOnClick) then FOnClick(Self);
end;

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

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

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


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


procedure TbsTrayIcon.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 TbsTrayIcon.DoMinimizeToTray;
begin
  HideMainForm;
  IconVisible := True;
end;


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


procedure TbsTrayIcon.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 TbsTrayIcon.HideMainForm;
begin
  if Owner is TWinControl
  then
    if Application.MainForm <> nil
    then
      begin
        Application.MainForm.Visible := False;
        ShowWindow(Application.Handle, SW_HIDE);
      end;
end;

end.