home *** CD-ROM | disk | FTP | other *** search
/ Softwarová Záchrana 3 / Softwarova-zachrana-3.bin / ArsClip / source.zip / UnitFrmSysTrayMenu.pas < prev    next >
Pascal/Delphi Source File  |  2004-10-16  |  16KB  |  552 lines
  1. unit UnitFrmSysTrayMenu;
  2. {
  3.     Purpose:
  4.         This unit is responsible for the system tray icon and it's
  5.         popup menu.
  6.     Updates:
  7.         Updated for option to show popup on double-click
  8.  
  9.         -------------
  10.         Show the version in the Icon "Hint"
  11.         -------------
  12.         Updated method of modifying the systray icon so it does change
  13.         the systray or move in position.
  14.  
  15.         Added public method to disable/enable systray icon changing
  16.  
  17.         Figured out a simple/reliable way to show picture on menu item
  18.         Using UnitClipQueue
  19. }
  20. interface
  21.  
  22. uses
  23.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  24.   Dialogs, Menus, ExtCtrls, ShellAPI, StdCtrls, ImgList ;
  25.  
  26.  
  27. const MY_WM_TRAYICON = WM_USER + 1; // used to receive tray icon messsages
  28.  
  29. type
  30.   TfrmSysTrayMenu = class(TForm)
  31.     Label1: TLabel;
  32.     ToggleTimer: TTimer;
  33.     ImageList1: TImageList;
  34.     procedure FormCreate(Sender: TObject);
  35.     procedure FormDestroy(Sender: TObject);
  36.     procedure ToggleTimerTimer(Sender: TObject);
  37.   private
  38.     { Private declarations }
  39.     TrayPopup : TPopupMenu;
  40.     TrayIcon: TNotifyIconData;          {tray icon info}
  41.     iconPic : TIcon;
  42.     DisableIconChanges : boolean;
  43.     PopupShowing : boolean;
  44.     WM_TASKBAR_CREATE : Cardinal;
  45.     ForceIconRestore : boolean;
  46.     JustSwitched : boolean;
  47.     targetEXE : string;
  48.  
  49.  
  50.  
  51.     procedure ExitMenuItemClickEvent(Sender: TObject);
  52.     //procedure FlushHistoryMenuItemClickEvent(sender : TObject);
  53.     procedure EditHistoryMenuItemClickEvent(sender : TObject);
  54.     procedure RemovedItemsMenuItemClickEvent(sender : Tobject);
  55.  
  56.     procedure ConfigureMenuItemClickEvent(Sender : TObject);
  57.     procedure RefreshMenuItemClickEvent(Sender : TObject);
  58.  
  59.     procedure SwitchMenuItemClickEvent(sender : TOBject);
  60.     procedure AboutClickEvent(sender : TObject);
  61.     procedure SetIconByIndex(index : longint);
  62.     procedure CreateTrayIcon;
  63.   public
  64.     procedure MethodMenuItemClickEvent(Sender : TObject);
  65.     procedure SwitchPermFolder(sender : TObject);
  66.     { Public declarations }
  67.  
  68.         procedure WMTrayIcon(var Msg: TMessage); message MY_WM_TRAYICON;
  69.         procedure WndProc(var Msg: TMessage); override; // trap new icon message
  70.  
  71.         procedure SetIconNormal;
  72.         procedure SetIconIgnore;
  73.         procedure SetIconTriggered;
  74.         procedure SetDisableIconChanges(value : boolean);
  75.         function GetJustSwitched : boolean;
  76.  
  77.  
  78.         procedure ShowPopup(inmenu : TMenuItem = nil);
  79.   end;
  80.  
  81. var
  82.   frmSysTrayMenu: TfrmSysTrayMenu;
  83.  
  84. implementation
  85.  
  86. uses  UnitFrmConfig, UnitFrmClipboardManager,
  87.   UnitFrmMainPopup, UnitClipQueue, UnitFrmAbout, UnitFrmRemoved,
  88.   UnitKeyboardQuery, UnitFrmPermanentNew, UnitMisc, UnitOtherQueue,
  89.   UnitPaste;
  90. {$R *.dfm}
  91.  
  92. {////////////////////}
  93. {//Public Interface//}
  94. {////////////////////}
  95.  
  96. procedure TFrmSysTrayMenu.SetDisableIconChanges(value: boolean);
  97. begin
  98.    self.DisableIconChanges := value;
  99. end;
  100.  
  101. procedure TFrmSysTrayMenu.SetIconNormal;
  102. var s : string;
  103. begin
  104.     ToggleTimer.Enabled := false;
  105.     if (not self.DisableIconChanges) or (self.ForceIconRestore) then begin
  106.         self.ForceIconRestore := false;
  107.         TrayIcon.cbSize := SizeOf(TrayIcon);
  108.         TrayIcon.Wnd := Self.Handle;
  109.         TrayIcon.uID := 0;
  110.         TrayIcon.uFlags := NIF_ICON or NIF_TIP or NIF_MESSAGE;
  111.         TrayIcon.uCallbackMessage := MY_WM_TRAYICON;
  112.         TrayIcon.hIcon := Application.Icon.Handle;
  113.         //TrayIcon.szTip := 'ArsClip';
  114.         s := 'ArsClip v' + FrmAbout.lblversion.caption + #0;
  115.         move(s[1], TrayIcon.szTip, length(s));
  116.  
  117.         ShellAPI.Shell_notifyIcon(NIM_MODIFY, @TrayIcon);
  118.     end;
  119. end;
  120.  
  121. procedure TFrmSysTrayMenu.SetIconIgnore;
  122. begin
  123.     self.SetIconByIndex(0);
  124. end;
  125.  
  126. procedure TFrmSysTrayMenu.SetIconTriggered;
  127. begin
  128.     self.SetIconByIndex(1);
  129. end;
  130.  
  131. procedure TFrmSysTrayMenu.SetIconByIndex(index : longint);
  132. var s : string;
  133. begin
  134.     ToggleTimer.Enabled := true;
  135.  
  136.     if (not self.DisableIconChanges) then begin
  137.         ImageList1.GetIcon(index, IconPic);
  138.         TrayIcon.cbSize := SizeOf(TrayIcon);
  139.         TrayIcon.Wnd := Self.Handle;
  140.         TrayIcon.uID := 0;
  141.         TrayIcon.uFlags := NIF_ICON or NIF_TIP or NIF_MESSAGE;
  142.         TrayIcon.uCallbackMessage := MY_WM_TRAYICON;
  143.  
  144.         TrayIcon.hIcon :=  IconPic.Handle;
  145.         //TrayIcon.szTip := 'ArsClip';
  146.         s := 'ArsClip v' + FrmAbout.lblversion.caption + #0;
  147.         move(s[1], TrayIcon.szTip, length(s));
  148.  
  149.         ShellAPI.Shell_notifyIcon(NIM_MODIFY, @TrayIcon);
  150.     end;
  151. end;
  152.  
  153.  
  154. {
  155. --========================
  156. -- // Create/Destroy   //
  157. --========================
  158. }
  159.  
  160. procedure TfrmSysTrayMenu.FormCreate(Sender: TObject);
  161. begin
  162.     TrayPopup := TPopupMenu.Create(self);
  163.     iconpic := TIcon.Create;
  164.  
  165.     self.CreateTrayIcon;
  166.     WM_TASKBAR_CREATE := RegisterWindowMessage('TaskbarCreated');
  167. end;
  168.  
  169. procedure TfrmSysTrayMenu.CreateTrayIcon;
  170. var s : string;
  171. begin
  172.     //
  173.     // create the initial icon
  174.     // NIM_MODIFY will be performed for updates
  175.     //
  176.     TrayIcon.cbSize := SizeOf(TrayIcon);
  177.     TrayIcon.Wnd := Self.Handle;
  178.     TrayIcon.uID := 0;
  179.     TrayIcon.uFlags := NIF_ICON or NIF_TIP or NIF_MESSAGE;
  180.     TrayIcon.uCallbackMessage := MY_WM_TRAYICON;
  181.     TrayIcon.hIcon := Application.Icon.Handle;
  182.     s := 'ArsClip v' + FrmAbout.lblversion.caption + #0;
  183.     move(s[1], TrayIcon.szTip, length(s));
  184.  
  185.     ShellAPI.Shell_notifyIcon(NIM_ADD, @TrayIcon);
  186.  
  187. end;
  188.  
  189.  
  190. procedure TfrmSysTrayMenu.FormDestroy(Sender: TObject);
  191. begin
  192.     //
  193.     // Remove tray icon
  194.     //
  195.     ShellAPI.Shell_notifyIcon(NIM_DELETE, @TrayIcon);
  196.  
  197.     TrayPopup.Items.Clear;
  198.     MyFree(TrayPopup);
  199.     MyFree(iconPic);
  200. end;
  201.  
  202.  
  203.  
  204.  
  205.  
  206.  
  207. {
  208. --========================
  209. -- // Trayicon messages //
  210. --========================
  211.                                           r
  212. Description: On a right click on the tray icon,
  213.     present a popup menu that allows the user to
  214.  
  215. close the program
  216. run configuration
  217. run permanent items
  218. switch permanent items
  219. flush the clipboard history
  220.  
  221. }
  222.  
  223.  
  224. procedure TfrmSysTrayMenu.WndProc(var Msg: TMessage);
  225. begin
  226.     if (msg.Msg = self.WM_TASKBAR_CREATE) then begin
  227.         self.ForceIconRestore := true;
  228.         self.CreateTrayIcon;
  229.     end else begin
  230.         inherited;
  231.     end;
  232. end;
  233.  
  234.  
  235. procedure TFrmSysTrayMenu.WMTrayIcon(var Msg: TMessage);
  236. begin
  237.     //
  238.     // show Popup menu on a right click
  239.     // show configuration form on a left double click
  240.     // show/hide debug window on right double click
  241.     //
  242.  
  243.     case msg.LParam of
  244.     WM_LBUTTONDOWN : begin
  245.         if (FrmConfig.cbPopupSingleclick.checked) then begin
  246.             FrmMainPopup.ShowOnNextWindow;
  247.         end else if (FrmConfig.cbPopupSingleclickTray.checked) then begin
  248.             FrmMainPopup.ShowOnSystemTray;
  249.         end;
  250.     end;
  251.     WM_Rbuttondown : begin
  252.         self.ShowPopup;
  253.     end;
  254.     WM_LBUTTONDBLCLK : begin
  255.         if (FrmConfig.cbPopupDoubleclick.checked) then begin
  256.             FrmMainPopup.ShowOnNextWindow;
  257.         end else if (FrmConfig.cbPopupDoubleclickTray.checked) then begin
  258.             FrmMainPopup.ShowOnSystemTray;
  259.         end else begin
  260.             frmconfig.show();
  261.         end;
  262.     end;
  263.     WM_RBUTTONDBLCLK : begin
  264.         frmMainPopup.Visible := frmMainPopup.Visible xor true;
  265.     end;
  266.     end;
  267.  
  268.  
  269. end;
  270.  
  271.  
  272.  
  273.  
  274. procedure TFrmSysTrayMenu.ShowPopup(inmenu : TMenuItem);
  275. var CursorPos : TPoint;
  276.     menu: TMenuItem;
  277.     submenu : TMenuItem;
  278.     i : integer;
  279.     s : string;
  280.     procedure ImageToBitmap(img : TImage; bmp : TBitmap);
  281.     begin
  282.         bmp.pixelformat := pf24bit;
  283.         bmp.Width := img.Width;
  284.         bmp.Height := img.Height;
  285.         bmp.Canvas.draw(0,0, img.Picture.Graphic);
  286.     end;
  287.     procedure AddToPopup(item : TMenuItem);
  288.     begin
  289.         if (inmenu = nil) then begin
  290.             TrayPopup.Items.Add(item);
  291.         end else begin
  292.             inmenu.Add(item);
  293.         end;
  294.     end;
  295. begin
  296.     if (self.PopupShowing) then EXIT;
  297.     self.PopupShowing := true;
  298.  
  299.     {
  300.     |=================|
  301.     | Configure       |
  302.     | Assign method to [program] |>|
  303.     |-----------------|
  304.     | Permenant Items |
  305.     | Switch to... |> |
  306.     |-----------------|
  307.     | Flush History   |
  308.     | Edit History    |
  309.     | Removed Items...|
  310.     |-----------------|
  311.     | About           |
  312.     | Exit            |
  313.     |=================|
  314.     }
  315.     UnitMisc.AppendLog('WMTrayIcon right button ');
  316.  
  317.     if (inmenu = nil) then begin
  318.         Windows.GetCursorPos(CursorPos);
  319.         TrayPopup.Items.Clear;
  320.         TrayPopup.AutoHotkeys := maAutomatic;
  321.     end;
  322.  
  323.     menu := TMenuItem.Create(TrayPopup);
  324.     menu.caption := '&Configure';
  325.     menu.OnClick := self.ConfigureMenuItemClickEvent;
  326.     menu.Bitmap := FrmMainPopup.imgA.Picture.Bitmap;
  327.     //menu.hint := IntToStr(Integer(@FrmMainPopup.imgA));
  328.     AddToPopup(menu);
  329.  
  330.     menu := TMenuItem.Create(TrayPopup);
  331.     menu.caption := '&Refresh Clipboard Monitoring';
  332.     menu.OnClick := self.RefreshMenuItemClickEvent;
  333.     //menu.Bitmap := FrmMainPopup.imgA.Picture.Bitmap;
  334.     AddToPopup(menu);
  335.  
  336.     menu := TMenuItem.Create(TrayPopup);
  337.     targetEXE := FrmMainPopup.GetNextWindowProgramName;
  338.     menu.caption := '&Paste Method for ' +  targetEXE;
  339.  
  340.  
  341.     submenu := TMenuItem.Create(menu);
  342.     submenu.Caption := '&1 CTRL+V';
  343.     submenu.Tag := Integer(PASTE_CTRL_V);
  344.     submenu.OnClick := self.MethodMenuItemClickEvent;
  345.     submenu.Checked := false;
  346.     menu.Add(submenu);
  347.  
  348.     submenu := TMenuItem.Create(menu);
  349.     submenu.Caption := '&2 SHIFT+INSERT';
  350.     submenu.Tag := Integer(PASTE_SHIFT_INS);
  351.     submenu.OnClick := self.MethodMenuItemClickEvent;
  352.     submenu.Checked := false;
  353.     menu.Add(submenu);
  354.  
  355.     submenu := TMenuItem.Create(menu);
  356.     submenu.Caption := '&3 Mimic Typing';
  357.     submenu.Tag := Integer(PASTE_MIMIC);
  358.     submenu.OnClick := self.MethodMenuItemClickEvent;
  359.     submenu.Checked := false;
  360.     menu.Add(submenu);
  361.  
  362.  
  363.  
  364.     submenu := TMenuItem.Create(menu);
  365.     submenu.Caption := '&4 Clipboard Only';
  366.     submenu.Tag := Integer(PASTE_CLIPBOARD);
  367.     submenu.OnClick := self.MethodMenuItemClickEvent;
  368.     submenu.Checked := false;
  369.     menu.Add(submenu);
  370.  
  371.     submenu := TMenuItem.Create(menu);
  372.     submenu.Caption := '&5 Default';
  373.     submenu.Tag := Integer(PASTE_DEFAULT);
  374.     submenu.OnClick := self.MethodMenuItemClickEvent;
  375.     submenu.Checked := false;
  376.     menu.Add(submenu);
  377.  
  378.     menu.Items[integer(Paste.GetPasteMethod(targetEXE))].Checked := true;
  379.  
  380.     AddToPopup(menu);
  381.     AddToPopup(NewLine());
  382.  
  383.  
  384.     menu := TMenuItem.Create(TrayPopup);
  385.     menu.Caption := 'Permanent Items';
  386.     menu.OnClick := self.SwitchMenuItemClickEvent;
  387.     menu.Bitmap := FrmMainPopup.imgRightArrow.Picture.Bitmap;
  388.     //menu.hint := IntToStr(Integer(@FrmMainPopup.imgRightArrow));
  389.     AddToPopup(menu);
  390.  
  391.     if (inmenu = nil) then begin
  392.         // switch to sub menu (checkmark current item)
  393.         menu := TMenuItem.Create(TrayPopup);
  394.         menu.Caption := 'Switch to...';
  395.         s := frmPermanent.GetPermanentPath;
  396.         for i := 0 to frmPermanent.PermFoldersGetCount - 1 do begin
  397.             submenu := TMenuItem.Create(menu);
  398.             submenu.hint := frmPermanent.PermFoldersGetItem(i);
  399.             submenu.caption := submenu.hint;
  400.             if (submenu.Hint = s) then begin
  401.                 submenu.Checked := true;
  402.             end;
  403.             submenu.OnClick := self.SwitchPermFolder;
  404.             menu.Insert(i, submenu)
  405.         end;
  406.         AddToPopup(menu);
  407.     end;
  408.  
  409.     AddToPopup(NewLine());
  410.     menu := TMenuItem.Create(TrayPopup);
  411.     menu.Caption := 'Flush Text';
  412.     menu.Bitmap := FrmMainPopup.imgFlush.Picture.Bitmap;
  413.     //menu.hint := IntToStr(Integer(@FrmMainPopup.imgFlush));
  414.     menu.OnClick := FrmMainPopup.FlushTextItemsClickEvent;
  415.     AddToPopup(menu);
  416.  
  417.  
  418.     menu := TMenuItem.Create(TrayPopup);
  419.     menu.Caption := 'Flush Non-Text';
  420.     menu.Bitmap := FrmMainPopup.imgFlush.Picture.Bitmap;
  421.     //menu.hint := IntToStr(Integer(@FrmMainPopup.imgFlush));
  422.     menu.OnClick := FrmMainPopup.FlushOtherItemsClickEvent;
  423.     AddToPopup(menu);
  424.     AddToPopup(NewLine());
  425.  
  426.     menu := TMenuItem.Create(TrayPopup);
  427.     menu.Caption := 'Edit History';
  428.     menu.Bitmap := FrmMainPopup.imgEdit.Picture.Bitmap;
  429.     //menu.hint := IntToStr(Integer(@FrmMainPopup.imgEdit));
  430.     menu.OnClick := self.EditHistoryMenuItemClickEvent;
  431.     AddToPopup(menu);
  432.  
  433.     menu := TMenuItem.Create(TrayPopup);
  434.     menu.Caption := 'Removed Items';
  435.     menu.Bitmap := FrmMainPopup.imgRemoved.Picture.Bitmap;
  436.     //menu.hint := IntToStr(Integer(@FrmMainPopup.imgRemoved));
  437.     menu.OnClick := self.RemovedItemsMenuItemClickEvent;
  438.     AddToPopup(menu);
  439.  
  440.  
  441.     TrayPopup.Items.Add(NewLine());
  442.     menu := TMenuItem.Create(TrayPopup);
  443.     menu.caption := 'About';
  444.     menu.OnClick := self.AboutClickEvent;
  445.     AddToPopup(menu);
  446.  
  447.     menu := TMenuItem.Create(TrayPopup);
  448.     menu.caption := 'Exit ArsClip';
  449.     menu.OnClick := self.ExitMenuItemClickEvent;
  450.     AddToPopup(menu);
  451.  
  452.  
  453.  
  454.  
  455.     if (inmenu = nil) then begin
  456.         UnitMisc.AppendLog('>>tray popup');
  457.         Windows.SetForegroundWindow(frmMainPopup.handle);
  458.         TrayPopup.Popup(CursorPos.x, CursorPos.y);
  459.         Windows.PostMessage(frmMainPopup.Handle, WM_NULL, 0, 0);
  460.         UnitMisc.AppendLog('>>tray popup done');
  461.     end;
  462.  
  463.  
  464.     self.PopupShowing := false;
  465. end;
  466.  
  467.  
  468. {
  469.   // menu item clicks
  470. }
  471.  
  472.  
  473. procedure TFrmSysTrayMenu.RefreshMenuItemClickEvent(Sender : TObject);
  474. begin
  475.     frmClipboardManager.RefreshClipboardMonitor;
  476. end;
  477. procedure TFrmSysTrayMenu.ExitMenuItemClickEvent(Sender: TObject);
  478. begin
  479.     // End the program nicely
  480.     frmMainPopup.Close;
  481. end;
  482. procedure TFrmSysTrayMenu.SwitchMenuItemClickEvent(sender : TOBject);
  483. begin
  484.     Windows.SetForegroundWindow(frmPermanent.Handle);
  485.     frmPermanent.Show;
  486. end;
  487. procedure TFrmSysTrayMenu.ConfigureMenuItemClickEvent(Sender : TObject);
  488. begin
  489.     Windows.SetForegroundWindow(frmConfig.Handle);
  490.     frmConfig.Show;
  491. end;
  492. procedure TFrmSysTrayMenu.SwitchPermFolder(sender : TObject);
  493. begin
  494.     with sender as TMenuItem do begin
  495.         frmPermanent.SetPermanentPath( hint );
  496.     end;
  497.  
  498.     self.JustSwitched := true;
  499. end;
  500. {
  501. procedure TFrmSysTrayMenu.FlushHistoryMenuItemClickEvent(sender : TObject);
  502. begin
  503.     if (Dialogs.MessageDlg('Flush all text and non-text items?',
  504.         mtConfirmation, [mbYes,mbNo],0) = mrYes) then begin
  505.         ClipQueue.ClearQueue;
  506.         OtherQueue.ClearQueue;
  507.     end;
  508. end;
  509. }
  510. procedure TFrmSysTrayMenu.EditHistoryMenuItemClickEvent(sender : TObject);
  511. begin
  512.     Windows.SetForegroundWindow(frmClipboardManager.Handle);
  513.     frmClipboardManager.Show;
  514. end;
  515.  
  516. procedure TFrmSysTrayMenu.AboutClickEvent(sender : TObject);
  517. begin
  518.     Windows.SetForegroundWindow(frmAbout.Handle);
  519.     frmAbout.show;
  520. end;
  521.  
  522.  
  523. procedure TFrmSysTrayMenu.RemovedItemsMenuItemClickEvent(sender : Tobject);
  524. begin
  525.     Windows.SetForegroundWindow(FrmRemoved.Handle);
  526.     FrmRemoved.Show;
  527. end;
  528.  
  529.  
  530. procedure TfrmSysTrayMenu.ToggleTimerTimer(Sender: TObject);
  531. begin
  532.     self.SetIconNormal;
  533. end;
  534.  
  535.  
  536.  
  537. function TfrmSysTrayMenu.GetJustSwitched: boolean;
  538. begin
  539.     result := self.JustSwitched;
  540.     self.JustSwitched := false;
  541. end;
  542.  
  543. procedure TfrmSysTrayMenu.MethodMenuItemClickEvent(Sender: TObject);
  544. var m : TMenuItem;
  545. begin
  546.     m := TMenuItem(sender);
  547.     Paste.AssignPaste(self.targetEXE, TPasteMethod(m.tag));
  548. end;
  549.  
  550.  
  551. end.
  552.