home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Softwarová Záchrana 3
/
Softwarova-zachrana-3.bin
/
ArsClip
/
source.zip
/
UnitFrmSysTrayMenu.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
2004-10-16
|
16KB
|
552 lines
unit UnitFrmSysTrayMenu;
{
Purpose:
This unit is responsible for the system tray icon and it's
popup menu.
Updates:
Updated for option to show popup on double-click
-------------
Show the version in the Icon "Hint"
-------------
Updated method of modifying the systray icon so it does change
the systray or move in position.
Added public method to disable/enable systray icon changing
Figured out a simple/reliable way to show picture on menu item
Using UnitClipQueue
}
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, ExtCtrls, ShellAPI, StdCtrls, ImgList ;
const MY_WM_TRAYICON = WM_USER + 1; // used to receive tray icon messsages
type
TfrmSysTrayMenu = class(TForm)
Label1: TLabel;
ToggleTimer: TTimer;
ImageList1: TImageList;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ToggleTimerTimer(Sender: TObject);
private
{ Private declarations }
TrayPopup : TPopupMenu;
TrayIcon: TNotifyIconData; {tray icon info}
iconPic : TIcon;
DisableIconChanges : boolean;
PopupShowing : boolean;
WM_TASKBAR_CREATE : Cardinal;
ForceIconRestore : boolean;
JustSwitched : boolean;
targetEXE : string;
procedure ExitMenuItemClickEvent(Sender: TObject);
//procedure FlushHistoryMenuItemClickEvent(sender : TObject);
procedure EditHistoryMenuItemClickEvent(sender : TObject);
procedure RemovedItemsMenuItemClickEvent(sender : Tobject);
procedure ConfigureMenuItemClickEvent(Sender : TObject);
procedure RefreshMenuItemClickEvent(Sender : TObject);
procedure SwitchMenuItemClickEvent(sender : TOBject);
procedure AboutClickEvent(sender : TObject);
procedure SetIconByIndex(index : longint);
procedure CreateTrayIcon;
public
procedure MethodMenuItemClickEvent(Sender : TObject);
procedure SwitchPermFolder(sender : TObject);
{ Public declarations }
procedure WMTrayIcon(var Msg: TMessage); message MY_WM_TRAYICON;
procedure WndProc(var Msg: TMessage); override; // trap new icon message
procedure SetIconNormal;
procedure SetIconIgnore;
procedure SetIconTriggered;
procedure SetDisableIconChanges(value : boolean);
function GetJustSwitched : boolean;
procedure ShowPopup(inmenu : TMenuItem = nil);
end;
var
frmSysTrayMenu: TfrmSysTrayMenu;
implementation
uses UnitFrmConfig, UnitFrmClipboardManager,
UnitFrmMainPopup, UnitClipQueue, UnitFrmAbout, UnitFrmRemoved,
UnitKeyboardQuery, UnitFrmPermanentNew, UnitMisc, UnitOtherQueue,
UnitPaste;
{$R *.dfm}
{////////////////////}
{//Public Interface//}
{////////////////////}
procedure TFrmSysTrayMenu.SetDisableIconChanges(value: boolean);
begin
self.DisableIconChanges := value;
end;
procedure TFrmSysTrayMenu.SetIconNormal;
var s : string;
begin
ToggleTimer.Enabled := false;
if (not self.DisableIconChanges) or (self.ForceIconRestore) then begin
self.ForceIconRestore := false;
TrayIcon.cbSize := SizeOf(TrayIcon);
TrayIcon.Wnd := Self.Handle;
TrayIcon.uID := 0;
TrayIcon.uFlags := NIF_ICON or NIF_TIP or NIF_MESSAGE;
TrayIcon.uCallbackMessage := MY_WM_TRAYICON;
TrayIcon.hIcon := Application.Icon.Handle;
//TrayIcon.szTip := 'ArsClip';
s := 'ArsClip v' + FrmAbout.lblversion.caption + #0;
move(s[1], TrayIcon.szTip, length(s));
ShellAPI.Shell_notifyIcon(NIM_MODIFY, @TrayIcon);
end;
end;
procedure TFrmSysTrayMenu.SetIconIgnore;
begin
self.SetIconByIndex(0);
end;
procedure TFrmSysTrayMenu.SetIconTriggered;
begin
self.SetIconByIndex(1);
end;
procedure TFrmSysTrayMenu.SetIconByIndex(index : longint);
var s : string;
begin
ToggleTimer.Enabled := true;
if (not self.DisableIconChanges) then begin
ImageList1.GetIcon(index, IconPic);
TrayIcon.cbSize := SizeOf(TrayIcon);
TrayIcon.Wnd := Self.Handle;
TrayIcon.uID := 0;
TrayIcon.uFlags := NIF_ICON or NIF_TIP or NIF_MESSAGE;
TrayIcon.uCallbackMessage := MY_WM_TRAYICON;
TrayIcon.hIcon := IconPic.Handle;
//TrayIcon.szTip := 'ArsClip';
s := 'ArsClip v' + FrmAbout.lblversion.caption + #0;
move(s[1], TrayIcon.szTip, length(s));
ShellAPI.Shell_notifyIcon(NIM_MODIFY, @TrayIcon);
end;
end;
{
--========================
-- // Create/Destroy //
--========================
}
procedure TfrmSysTrayMenu.FormCreate(Sender: TObject);
begin
TrayPopup := TPopupMenu.Create(self);
iconpic := TIcon.Create;
self.CreateTrayIcon;
WM_TASKBAR_CREATE := RegisterWindowMessage('TaskbarCreated');
end;
procedure TfrmSysTrayMenu.CreateTrayIcon;
var s : string;
begin
//
// create the initial icon
// NIM_MODIFY will be performed for updates
//
TrayIcon.cbSize := SizeOf(TrayIcon);
TrayIcon.Wnd := Self.Handle;
TrayIcon.uID := 0;
TrayIcon.uFlags := NIF_ICON or NIF_TIP or NIF_MESSAGE;
TrayIcon.uCallbackMessage := MY_WM_TRAYICON;
TrayIcon.hIcon := Application.Icon.Handle;
s := 'ArsClip v' + FrmAbout.lblversion.caption + #0;
move(s[1], TrayIcon.szTip, length(s));
ShellAPI.Shell_notifyIcon(NIM_ADD, @TrayIcon);
end;
procedure TfrmSysTrayMenu.FormDestroy(Sender: TObject);
begin
//
// Remove tray icon
//
ShellAPI.Shell_notifyIcon(NIM_DELETE, @TrayIcon);
TrayPopup.Items.Clear;
MyFree(TrayPopup);
MyFree(iconPic);
end;
{
--========================
-- // Trayicon messages //
--========================
r
Description: On a right click on the tray icon,
present a popup menu that allows the user to
close the program
run configuration
run permanent items
switch permanent items
flush the clipboard history
}
procedure TfrmSysTrayMenu.WndProc(var Msg: TMessage);
begin
if (msg.Msg = self.WM_TASKBAR_CREATE) then begin
self.ForceIconRestore := true;
self.CreateTrayIcon;
end else begin
inherited;
end;
end;
procedure TFrmSysTrayMenu.WMTrayIcon(var Msg: TMessage);
begin
//
// show Popup menu on a right click
// show configuration form on a left double click
// show/hide debug window on right double click
//
case msg.LParam of
WM_LBUTTONDOWN : begin
if (FrmConfig.cbPopupSingleclick.checked) then begin
FrmMainPopup.ShowOnNextWindow;
end else if (FrmConfig.cbPopupSingleclickTray.checked) then begin
FrmMainPopup.ShowOnSystemTray;
end;
end;
WM_Rbuttondown : begin
self.ShowPopup;
end;
WM_LBUTTONDBLCLK : begin
if (FrmConfig.cbPopupDoubleclick.checked) then begin
FrmMainPopup.ShowOnNextWindow;
end else if (FrmConfig.cbPopupDoubleclickTray.checked) then begin
FrmMainPopup.ShowOnSystemTray;
end else begin
frmconfig.show();
end;
end;
WM_RBUTTONDBLCLK : begin
frmMainPopup.Visible := frmMainPopup.Visible xor true;
end;
end;
end;
procedure TFrmSysTrayMenu.ShowPopup(inmenu : TMenuItem);
var CursorPos : TPoint;
menu: TMenuItem;
submenu : TMenuItem;
i : integer;
s : string;
procedure ImageToBitmap(img : TImage; bmp : TBitmap);
begin
bmp.pixelformat := pf24bit;
bmp.Width := img.Width;
bmp.Height := img.Height;
bmp.Canvas.draw(0,0, img.Picture.Graphic);
end;
procedure AddToPopup(item : TMenuItem);
begin
if (inmenu = nil) then begin
TrayPopup.Items.Add(item);
end else begin
inmenu.Add(item);
end;
end;
begin
if (self.PopupShowing) then EXIT;
self.PopupShowing := true;
{
|=================|
| Configure |
| Assign method to [program] |>|
|-----------------|
| Permenant Items |
| Switch to... |> |
|-----------------|
| Flush History |
| Edit History |
| Removed Items...|
|-----------------|
| About |
| Exit |
|=================|
}
UnitMisc.AppendLog('WMTrayIcon right button ');
if (inmenu = nil) then begin
Windows.GetCursorPos(CursorPos);
TrayPopup.Items.Clear;
TrayPopup.AutoHotkeys := maAutomatic;
end;
menu := TMenuItem.Create(TrayPopup);
menu.caption := '&Configure';
menu.OnClick := self.ConfigureMenuItemClickEvent;
menu.Bitmap := FrmMainPopup.imgA.Picture.Bitmap;
//menu.hint := IntToStr(Integer(@FrmMainPopup.imgA));
AddToPopup(menu);
menu := TMenuItem.Create(TrayPopup);
menu.caption := '&Refresh Clipboard Monitoring';
menu.OnClick := self.RefreshMenuItemClickEvent;
//menu.Bitmap := FrmMainPopup.imgA.Picture.Bitmap;
AddToPopup(menu);
menu := TMenuItem.Create(TrayPopup);
targetEXE := FrmMainPopup.GetNextWindowProgramName;
menu.caption := '&Paste Method for ' + targetEXE;
submenu := TMenuItem.Create(menu);
submenu.Caption := '&1 CTRL+V';
submenu.Tag := Integer(PASTE_CTRL_V);
submenu.OnClick := self.MethodMenuItemClickEvent;
submenu.Checked := false;
menu.Add(submenu);
submenu := TMenuItem.Create(menu);
submenu.Caption := '&2 SHIFT+INSERT';
submenu.Tag := Integer(PASTE_SHIFT_INS);
submenu.OnClick := self.MethodMenuItemClickEvent;
submenu.Checked := false;
menu.Add(submenu);
submenu := TMenuItem.Create(menu);
submenu.Caption := '&3 Mimic Typing';
submenu.Tag := Integer(PASTE_MIMIC);
submenu.OnClick := self.MethodMenuItemClickEvent;
submenu.Checked := false;
menu.Add(submenu);
submenu := TMenuItem.Create(menu);
submenu.Caption := '&4 Clipboard Only';
submenu.Tag := Integer(PASTE_CLIPBOARD);
submenu.OnClick := self.MethodMenuItemClickEvent;
submenu.Checked := false;
menu.Add(submenu);
submenu := TMenuItem.Create(menu);
submenu.Caption := '&5 Default';
submenu.Tag := Integer(PASTE_DEFAULT);
submenu.OnClick := self.MethodMenuItemClickEvent;
submenu.Checked := false;
menu.Add(submenu);
menu.Items[integer(Paste.GetPasteMethod(targetEXE))].Checked := true;
AddToPopup(menu);
AddToPopup(NewLine());
menu := TMenuItem.Create(TrayPopup);
menu.Caption := 'Permanent Items';
menu.OnClick := self.SwitchMenuItemClickEvent;
menu.Bitmap := FrmMainPopup.imgRightArrow.Picture.Bitmap;
//menu.hint := IntToStr(Integer(@FrmMainPopup.imgRightArrow));
AddToPopup(menu);
if (inmenu = nil) then begin
// switch to sub menu (checkmark current item)
menu := TMenuItem.Create(TrayPopup);
menu.Caption := 'Switch to...';
s := frmPermanent.GetPermanentPath;
for i := 0 to frmPermanent.PermFoldersGetCount - 1 do begin
submenu := TMenuItem.Create(menu);
submenu.hint := frmPermanent.PermFoldersGetItem(i);
submenu.caption := submenu.hint;
if (submenu.Hint = s) then begin
submenu.Checked := true;
end;
submenu.OnClick := self.SwitchPermFolder;
menu.Insert(i, submenu)
end;
AddToPopup(menu);
end;
AddToPopup(NewLine());
menu := TMenuItem.Create(TrayPopup);
menu.Caption := 'Flush Text';
menu.Bitmap := FrmMainPopup.imgFlush.Picture.Bitmap;
//menu.hint := IntToStr(Integer(@FrmMainPopup.imgFlush));
menu.OnClick := FrmMainPopup.FlushTextItemsClickEvent;
AddToPopup(menu);
menu := TMenuItem.Create(TrayPopup);
menu.Caption := 'Flush Non-Text';
menu.Bitmap := FrmMainPopup.imgFlush.Picture.Bitmap;
//menu.hint := IntToStr(Integer(@FrmMainPopup.imgFlush));
menu.OnClick := FrmMainPopup.FlushOtherItemsClickEvent;
AddToPopup(menu);
AddToPopup(NewLine());
menu := TMenuItem.Create(TrayPopup);
menu.Caption := 'Edit History';
menu.Bitmap := FrmMainPopup.imgEdit.Picture.Bitmap;
//menu.hint := IntToStr(Integer(@FrmMainPopup.imgEdit));
menu.OnClick := self.EditHistoryMenuItemClickEvent;
AddToPopup(menu);
menu := TMenuItem.Create(TrayPopup);
menu.Caption := 'Removed Items';
menu.Bitmap := FrmMainPopup.imgRemoved.Picture.Bitmap;
//menu.hint := IntToStr(Integer(@FrmMainPopup.imgRemoved));
menu.OnClick := self.RemovedItemsMenuItemClickEvent;
AddToPopup(menu);
TrayPopup.Items.Add(NewLine());
menu := TMenuItem.Create(TrayPopup);
menu.caption := 'About';
menu.OnClick := self.AboutClickEvent;
AddToPopup(menu);
menu := TMenuItem.Create(TrayPopup);
menu.caption := 'Exit ArsClip';
menu.OnClick := self.ExitMenuItemClickEvent;
AddToPopup(menu);
if (inmenu = nil) then begin
UnitMisc.AppendLog('>>tray popup');
Windows.SetForegroundWindow(frmMainPopup.handle);
TrayPopup.Popup(CursorPos.x, CursorPos.y);
Windows.PostMessage(frmMainPopup.Handle, WM_NULL, 0, 0);
UnitMisc.AppendLog('>>tray popup done');
end;
self.PopupShowing := false;
end;
{
// menu item clicks
}
procedure TFrmSysTrayMenu.RefreshMenuItemClickEvent(Sender : TObject);
begin
frmClipboardManager.RefreshClipboardMonitor;
end;
procedure TFrmSysTrayMenu.ExitMenuItemClickEvent(Sender: TObject);
begin
// End the program nicely
frmMainPopup.Close;
end;
procedure TFrmSysTrayMenu.SwitchMenuItemClickEvent(sender : TOBject);
begin
Windows.SetForegroundWindow(frmPermanent.Handle);
frmPermanent.Show;
end;
procedure TFrmSysTrayMenu.ConfigureMenuItemClickEvent(Sender : TObject);
begin
Windows.SetForegroundWindow(frmConfig.Handle);
frmConfig.Show;
end;
procedure TFrmSysTrayMenu.SwitchPermFolder(sender : TObject);
begin
with sender as TMenuItem do begin
frmPermanent.SetPermanentPath( hint );
end;
self.JustSwitched := true;
end;
{
procedure TFrmSysTrayMenu.FlushHistoryMenuItemClickEvent(sender : TObject);
begin
if (Dialogs.MessageDlg('Flush all text and non-text items?',
mtConfirmation, [mbYes,mbNo],0) = mrYes) then begin
ClipQueue.ClearQueue;
OtherQueue.ClearQueue;
end;
end;
}
procedure TFrmSysTrayMenu.EditHistoryMenuItemClickEvent(sender : TObject);
begin
Windows.SetForegroundWindow(frmClipboardManager.Handle);
frmClipboardManager.Show;
end;
procedure TFrmSysTrayMenu.AboutClickEvent(sender : TObject);
begin
Windows.SetForegroundWindow(frmAbout.Handle);
frmAbout.show;
end;
procedure TFrmSysTrayMenu.RemovedItemsMenuItemClickEvent(sender : Tobject);
begin
Windows.SetForegroundWindow(FrmRemoved.Handle);
FrmRemoved.Show;
end;
procedure TfrmSysTrayMenu.ToggleTimerTimer(Sender: TObject);
begin
self.SetIconNormal;
end;
function TfrmSysTrayMenu.GetJustSwitched: boolean;
begin
result := self.JustSwitched;
self.JustSwitched := false;
end;
procedure TfrmSysTrayMenu.MethodMenuItemClickEvent(Sender: TObject);
var m : TMenuItem;
begin
m := TMenuItem(sender);
Paste.AssignPaste(self.targetEXE, TPasteMethod(m.tag));
end;
end.