home *** CD-ROM | disk | FTP | other *** search
/ Softwarová Záchrana 3 / Softwarova-zachrana-3.bin / ArsClip / source.zip / UnitArsClip.pas < prev    next >
Pascal/Delphi Source File  |  2002-03-08  |  25KB  |  853 lines
  1. unit UnitArsClip;
  2.  
  3. interface
  4. uses
  5.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  6.   Dialogs, StdCtrls, Clipbrd, Menus, StrUtils, ShellAPI, ExtCtrls;
  7.  
  8.   const MY_WM_TRAYICON = WM_USER + 1; // used to receive tray icon messsages
  9.  
  10.   type
  11.   TForm1 = class(TForm)
  12.     Memo1: TMemo;
  13.     lbQueue: TListBox;
  14.     btnHide: TButton;
  15.     Image1: TImage;
  16.  
  17.     procedure FormCreate(Sender: TObject);
  18.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  19.     procedure btnHideClick(Sender: TObject);
  20.   private
  21.     { Private declarations }
  22.  
  23.     HotKeyForeWindow: cardinal;         {target window for text pasting}
  24.     HotKeyTarget: cardinal;             {target control with keyboard focus}
  25.     NextHandle: THandle;                {clipboard chain pointer}
  26.     Popup: TPopupMenu;                  {text pasting popup}
  27.     TrayPopup: TPopupMenu;              {tray icon's popup}
  28.  
  29.     QueueSize: integer;                 {number of clipboard items to store}
  30.     LastStringSelected: string;         {last selected queue item from Popup}
  31.     TrayIcon: TNotifyIconData;          {tray icon info}
  32.  
  33.     ThreadOurs: cardinal;               {Used soley by ThreadAttach/Detach}
  34.     ThreadTarget: cardinal;
  35.     ThreadAttached: boolean;
  36.  
  37.     IgnoreClipboard: boolean;           {altered by public interface}
  38.     DisableMonitoring: boolean;
  39.     PopupUseKB: boolean;
  40.     UsePermanentItems: boolean;
  41.     UseKeyboardMimic: boolean;
  42.  
  43.     PasteHandle : THandle;
  44.  
  45.     function ThreadAttach(TargetWindow: cardinal) : boolean;
  46.     procedure ThreadDetach();
  47.  
  48.     procedure GetTargetControl(ParentWindow: cardinal;
  49.         var TargetHandle: cardinal;
  50.         var TargetX: integer;
  51.         var TargetY: integer);
  52.  
  53.     procedure ShowPopup(X,Y: integer);
  54.     procedure MenuItemClickEvent(Sender: TObject);
  55.     procedure LastMenuItemClickEvent(Sender: TObject);
  56.     procedure CancelMenuItemClickEvent(Sender: TObject);
  57.     procedure PermanentMenutItemClickEvent(sender: TObject);
  58.  
  59.  
  60.     procedure SendText(s : string);
  61.  
  62.     procedure AppendLog(s : string);
  63.   protected
  64.   public
  65.     {public declarations}
  66.  
  67.     {configuration}
  68.     procedure PopupUseKeyboard(usekb: boolean);
  69.     procedure SetQueueSize(qsize: integer);
  70.     procedure SetMonitoring(disable: boolean);
  71.     procedure SetPermanentItems(DoUse: boolean);
  72.     procedure SetPasteMethod(MimicKeyboard : boolean);
  73.  
  74.     {windows messages}
  75.     procedure WMDRAWCLIPBOARD(var Message: TMessage); message WM_DRAWCLIPBOARD;
  76.     procedure WMCHANGECBCHAIN(var Message: TMessage); message WM_CHANGECBCHAIN;
  77.  
  78.     {system tray stuff}
  79.     procedure WMHotKey(var Msg : TWMHotKey); message WM_HOTKEY;
  80.     procedure WMTrayIcon(var Msg: TMessage); message MY_WM_TRAYICON;
  81.     procedure ExitMenuItemClickEvent(Sender: TObject);
  82.     procedure SwitchMenuItemClickEvent(sender : TOBject);
  83.     procedure SwithPermFolder(sender : TObject);
  84.     procedure ConfigureMenuItemClickEven(Sender : TObject);
  85.     procedure FlushHistoryMenuItemClickEvent(sender : TObject);
  86.   end;
  87.  
  88. var
  89.   Form1: TForm1;
  90. implementation
  91.  
  92. uses UnitFrmConfig, UnitFrmPermanent;
  93.  
  94. {$R *.dfm}
  95.  
  96. {
  97. --========================
  98. -- // Public Interface //
  99. --========================
  100. }
  101. procedure TForm1.PopupUseKeyboard(usekb: boolean);
  102. begin
  103.     self.PopupUseKB := usekb;
  104. end;
  105.  
  106. procedure TForm1.SetQueueSize(qsize: integer);
  107. begin
  108.     self.QueueSize := qsize;
  109.     while lbqueue.Count > qsize do
  110.         lbqueue.Items.Delete(lbqueue.Count - 1);
  111. end;
  112.  
  113. procedure Tform1.SetMonitoring(disable: boolean);
  114. begin
  115.     self.DisableMonitoring := disable;
  116. end;
  117.  
  118. procedure TForm1.SetPermanentItems(DoUse: boolean);
  119. begin
  120.     self.UsePermanentItems := douse;
  121. end;
  122.  
  123.  
  124. procedure TForm1.SetPasteMethod(MimicKeyboard : boolean);
  125. begin
  126.     UseKeyboardMimic := MimicKeyboard;
  127. end;
  128.  
  129. {
  130. --========================
  131. -- // Set/Release Hooks //
  132. --========================
  133.  
  134. Description: Monitor the clipboard, assign a hotkey, show our tray icon,
  135. and ready our programmatically created popup menus. Also, release all of these
  136. resources on form close.
  137.  
  138. }
  139. procedure TForm1.FormCreate(Sender: TObject);
  140. begin
  141.     //
  142.     //Join the cliboard chain
  143.     //
  144.     NextHandle := Windows.SetClipboardViewer(self.Handle);
  145.  
  146.  
  147.  
  148.     //
  149.     // Create System Tray Icon
  150.     // Set the callback hook to our icon handler
  151.     //
  152.     TrayIcon.cbSize := SizeOf(TrayIcon);
  153.     TrayIcon.Wnd := Self.Handle;
  154.     TrayIcon.uID := 0;
  155.     TrayIcon.uFlags := NIF_ICON or NIF_TIP or NIF_MESSAGE;
  156.     TrayIcon.uCallbackMessage := MY_WM_TRAYICON;
  157.     TrayIcon.hIcon := Application.Icon.Handle;
  158.     TrayIcon.szTip := 'ArsClip';
  159.     ShellAPI.Shell_notifyIcon(NIM_ADD, @TrayIcon);
  160.  
  161.  
  162.     //
  163.     // popup & menu items init
  164.     //
  165.     self.ShowHint := true;
  166.     Popup := TPopupMenu.Create(self);
  167.  
  168.     TrayPopup := TPopupMenu.Create(self);
  169.     //QueueSize := 15;
  170.     ThreadAttached := false;
  171.  
  172.     UseKeyboardMimic := false;
  173. end;
  174. procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
  175. begin
  176.     //
  177.     // clean up popup resources
  178.     //
  179.     TrayPopup.Items.Clear;
  180.     TrayPopup.Free;
  181.     Popup.Items.Clear;
  182.     Popup.Free;
  183.  
  184.     //
  185.     // Remove tray icon
  186.     //
  187.     ShellAPI.Shell_notifyIcon(NIM_DELETE, @TrayIcon);
  188.  
  189.     //
  190.     //Leave the chain
  191.     //
  192.     Windows.ChangeClipboardChain(Handle,     // our handle to remove
  193.                        NextHandle ); // handle of next window in the chain
  194. end;
  195.  
  196.  
  197. {
  198. --========================
  199. -- // Trayicon messages //
  200. --========================
  201.  
  202. Description: On a right click on the tray icon, present a popup menu
  203. that allows the user to
  204. close the program
  205. call up the permanent items form
  206.  
  207. }
  208.  
  209. procedure TForm1.WMTrayIcon(var Msg: TMessage);
  210. var menu: TMenuItem;
  211.     submenu : TMenuItem;
  212.     CursorPos : TPoint;
  213.     i : integer;
  214.     lib : cardinal;
  215.     stm : TMemoryStream;
  216. begin
  217.     //
  218.     // show exit popup on a right click
  219.     //
  220.     if (Msg.lparam = WM_Rbuttondown) then begin
  221.         AppendLog('WMTrayIcon right button ' + IntToStr(msg.Msg));
  222.  
  223.         Windows.GetCursorPos(CursorPos);
  224.         TrayPopup.Items.Clear;
  225.         TrayPopup.AutoHotkeys := maAutomatic;
  226.  
  227.         menu := TMenuItem.Create(TrayPopup);
  228.         menu.caption := '&Configure';
  229.         menu.OnClick := self.ConfigureMenuItemClickEven;
  230.  
  231.         image1.Picture.Icon := application.Icon;
  232.         menu.Bitmap.pixelformat := pf24bit;
  233.         menu.Bitmap.Width := application.Icon.Width;
  234.         menu.Bitmap.Height := application.Icon.Height;
  235.         menu.Bitmap.Canvas.draw(0,0, image1.Picture.Graphic);
  236.  
  237.         TrayPopup.Items.Add(menu);
  238.         TrayPopup.Items.Add(NewLine());
  239.  
  240.         menu := TMenuItem.Create(TrayPopup);
  241.         menu.Caption := '&Permanent Items';
  242.         menu.OnClick := self.SwitchMenuItemClickEvent;
  243.         TrayPopup.Items.Add(menu);
  244.  
  245.         TrayPopup.Items.Add(NewLine());
  246.         menu := TMenuItem.Create(TrayPopup);
  247.         menu.Caption := '&Switch to...';
  248.         TrayPopup.Items.Add(NewLine());
  249.         for i := 0 to frmPermanent.PermFoldersGetCount - 1 do begin
  250.             submenu := TMenuItem.Create(menu);
  251.             submenu.Caption := frmPermanent.PermFoldersGetItem(i);
  252.             submenu.hint := submenu.caption;
  253.             submenu.OnClick := self.SwithPermFolder;
  254.             menu.Insert(i, submenu)
  255.         end;
  256.         TrayPopup.Items.Add(menu);
  257.  
  258.         menu := TMenuItem.Create(TrayPopup);
  259.         menu.Caption := '&Flush History';
  260.         menu.OnClick := self.FlushHistoryMenuItemClickEvent;
  261.         TrayPopup.Items.Add(menu);
  262.  
  263.  
  264.         TrayPopup.Items.Add(NewLine());
  265.         menu := TMenuItem.Create(TrayPopup);
  266.         menu.caption := '&Exit';
  267.         menu.OnClick := self.ExitMenuItemClickEvent;
  268.         TrayPopup.Items.Add(menu);
  269.  
  270.  
  271.         AppendLog('tray popup');
  272.  
  273.         Windows.SetForegroundWindow(self.handle);
  274.         TrayPopup.Popup(CursorPos.x, CursorPos.y);
  275.         Windows.PostMessage(self.Handle, WM_NULL, 0, 0);
  276.  
  277.         AppendLog('tray popup done');
  278.     end else if (msg.LParam = WM_LBUTTONDBLCLK ) then begin
  279.     //
  280.     // show configuration form on a left double click
  281.     //
  282.         frmconfig.show();
  283.     end else if (msg.LParam = WM_RBUTTONDBLCLK ) then begin
  284.     //
  285.     // show/hide debug window on right double click
  286.     //
  287.         self.Visible := self.Visible xor true;
  288.     end;
  289. end;
  290. {
  291.   // menu item clicks
  292. }
  293. procedure TForm1.ExitMenuItemClickEvent(Sender: TObject);
  294. begin
  295.     // End the program nicely
  296.     self.Close;
  297. end;
  298. procedure TForm1.SwitchMenuItemClickEvent(sender : TOBject);
  299. begin
  300.     frmPermanent.Show;
  301. end;
  302. procedure TForm1.ConfigureMenuItemClickEven(Sender : TObject);
  303. begin
  304.     frmConfig.Show;
  305. end;
  306. procedure TForm1.SwithPermFolder(sender : TObject);
  307. begin
  308.     with sender as TMenuItem do begin
  309.         frmPermanent.SetPermanentPath( hint );
  310.     end;
  311. end;
  312. procedure TForm1.FlushHistoryMenuItemClickEvent(sender : TObject);
  313. begin
  314.     self.lbQueue.items.clear;
  315. end;
  316.  
  317.  
  318. {
  319. --=========================
  320. -- // Clipboard messages //
  321. --=========================
  322.  
  323. Description: Monitor for new text entries entered into the clipboard. Add
  324. new text entries into the finite sized queue (removing oldest items as needed).
  325. Also, follow the rule for a change in the clipboard chain.
  326.  
  327. }
  328. procedure TForm1.WMDRAWCLIPBOARD(var Message: TMessage);
  329. var s: string;
  330.     i: integer;
  331.     dupFound: boolean;
  332. label exit_code;
  333.  
  334.     function GetClipboardText: string;
  335.     var hnd: THandle;
  336.         p: ^string;
  337.     begin
  338.         result := '';
  339.         try
  340.             if clipboard.HasFormat(CF_TEXT) then begin
  341.                 if (Windows.OpenClipboard(Application.Handle)) then begin
  342.                     hnd := Windows.GetClipboardData(CF_TEXT);
  343.                     if (hnd <> 0) then begin
  344.                         result := PChar(hnd);
  345.                     end;
  346.                     Windows.CloseClipboard;
  347.                 end;
  348.             end;
  349.         finally
  350.         end;
  351.     end;
  352.  
  353. begin
  354.     AppendLog('//// Clipboard Start ////');
  355.     //
  356.     // disabled?
  357.     // Ignore the clipboard for now?
  358.     //
  359.     if (DisableMonitoring) then begin
  360.         AppendLog('    Monitoring disabled');
  361.         goto exit_code;
  362.     end;
  363.     if (IgnoreClipboard) then begin
  364.         AppendLog('    Ignoring data when sending text to target control');
  365.         goto exit_code;
  366.     end;
  367.     IgnoreClipboard := true;
  368.  
  369.     //
  370.     // If I don't ignore another message, I'll get a "can't open clipboard"
  371.     // error because of an async call.
  372.     // This happens when text is selected in an Outlook email, copied, not unselected,
  373.     // and another email is selected or opened.
  374.     // Damn hard to find bug!!!
  375.  
  376.  
  377.  
  378.     //
  379.     // make sure the data isn't from us
  380.     //
  381.     if GetClipboardOwner = self.Handle then begin
  382.         AppendLog('    Ignore our own clipboard events');
  383.         goto exit_code;
  384.     end;
  385.  
  386.     //
  387.     // Clipboard contents have changed
  388.     // Add to start of queue
  389.     //
  390.     appendlog('    WM_DRawclipboard message');
  391.     appendlog(
  392.         '    # = ' + IntToStr(message.msg) +
  393.         ' lparam = ' + IntToStr(message.LParam) +
  394.         ' wparam = ' + IntToStr(message.WParam)
  395.     );
  396.  
  397.     //
  398.     // Copy the contents if it is text
  399.     //
  400.     try
  401.         // open/close should'n't be needed here
  402.         //clipboard.Open();
  403.         AppendLog('    Attempting to retrieve clipboard text');
  404.         s := GetClipboardText;
  405.  
  406.         if (s <> '') then begin
  407.             dupFound := false;
  408.             for i := 0 to lbQueue.count - 1 do begin
  409.                 if (s = lbQueue.items[i]) then dupfound := true;
  410.             end;
  411.             if not DupFound then begin
  412.                 AppendLog('    clipboard text = ' + s);
  413.  
  414.                 lbqueue.Items.Insert(0, s);
  415.                 // trim the queue size, dup oldest entry
  416.                 if (lbQueue.items.Count = QueueSize) then lbQueue.items.Delete(lbqueue.count - 1);
  417.             end else begin
  418.                 AppendLog('    Ignoring duplicate');
  419.             end;
  420.         end else begin
  421.             AppendLog('    Empty string in clipboard or error retreiving text.');
  422.         end;
  423.     finally
  424.         //clipboard.Close();
  425.     end;
  426.  
  427.  
  428. exit_code:
  429.     // Pass message to next in line (rules of a cliboard viewer)
  430.     Message.Result := 0;
  431.     If (NextHandle <> 0) then begin
  432.         Windows.SendMessage(NextHandle, WM_DRAWCLIPBOARD,  message.WParam, message.LParam )
  433.     end;
  434.     AppendLog('//// Clipboard End ////');
  435.     IgnoreClipboard := false;
  436. end;
  437.  
  438. procedure TForm1.WMCHANGECBCHAIN(var Message: TMessage);
  439. begin
  440.     //
  441.     //Someone is leaving the chain
  442.     //
  443.  
  444.     { MS Documentation...
  445.     When a clipboard viewer window receives the WM_CHANGECBCHAIN message,
  446.     it should call the SendMessage function to pass the message to the
  447.     next window in the chain, unless the next window is the window being
  448.     removed. In this case, the clipboard viewer should save the handle
  449.     specified by the lParam parameter as the next window in the chain.
  450.     }
  451.     if (Message.WParam = NextHandle) then begin
  452.         AppendLog('WM_Changecbchain - reassign next handle');
  453.         NextHandle := Message.LParam;
  454.     end else if (NextHandle <> 0) then begin
  455.         AppendLog('WM_Changecbchain - send message to next handle');
  456.         if NextHandle <> 0 then
  457.             sendmessage(NextHandle,
  458.                         WM_CHANGECBCHAIN,
  459.                         Message.WParam,  // handle of window to remove
  460.                         Message.LParam); // handle of next window
  461.     end;
  462.     Message.Result := 0;
  463. end;
  464.  
  465. {
  466. --======================
  467. -- // HotKey Message  //
  468. --======================
  469.  
  470. Description: Determine the control with keyboard focus at the time the
  471. hot key is pressed. Show the popup without taking keyboard focus away from
  472. the target control. If the popup looses focus, it disapears. If cancel is not
  473. selected, program flow proceeds to  "// Popup MenuItem Click //".
  474.  
  475. }
  476. procedure TForm1.WMHotKey(var Msg: TWMHotKey);
  477. var TargetX, TargetY: integer;
  478. begin
  479.     //--
  480.     //-- Insert the clipboard info into they control the user is typing in
  481.     //--
  482.     if (msg.HotKey <> FrmConfig.GetHotKeyID) then begin
  483.         exit
  484.     end;
  485.  
  486.     AppendLog('WM_Hotkey - received');
  487.  
  488.     self.HotKeyForeWindow := Windows.GetForegroundWindow();
  489.     if (self.HotKeyForeWindow <> 0) then begin
  490.         GetTargetControl(self.HotKeyForeWindow, self.HotKeyTarget,
  491.             TargetX, TargetY);
  492.         if (HotKeyTarget <> 0) then begin
  493.             //
  494.             // Attaching to the target keys the popup from
  495.             // taking away focus from the target item.
  496.             // Example, pasting to the name of a desktop icon. If you remove
  497.             // focus, you remove the rename box
  498.             //
  499.             if (self.PopupUseKB) then begin
  500.                 // we need to be foreground for keyboard focus
  501.                 SetForegroundWindow(self.Handle);
  502.                 self.ShowPopup(TargetX, TargetY);
  503.  
  504.             end else begin
  505.                 if (self.ThreadAttach(self.HotKeyForeWindow)) then begin
  506.                     self.ShowPopup(TargetX, TargetY);
  507.                     self.ThreadDetach();
  508.                 end else begin
  509.                     ShowMessage('Couldn''t attach popup menu to this window');
  510.                 end;
  511.             end;
  512.         end else begin
  513.             ShowMessage('Couldn''t find control to target');
  514.         end;
  515.  
  516.     end else begin
  517.         ShowMessage('Coulnd''t get foreground window');
  518.     end;
  519.  
  520. end;
  521.  
  522. procedure TForm1.GetTargetControl(ParentWindow: cardinal;
  523.     var TargetHandle: cardinal;
  524.     var TargetX: integer;
  525.     var TargetY: integer);
  526. var CaretPos: TPoint;
  527.     Rect: TRect;
  528. begin
  529.     //
  530.     // attempt to get target control's handle and
  531.     // the position of the caret in the text window
  532.     //
  533.     TargetHandle := 0;
  534.     if (self.ThreadAttach(ParentWindow)) then begin
  535.         TargetHandle := Windows.GetFocus();
  536.         if (TargetHandle <> 0) then begin
  537.             Windows.GetCaretPos(CaretPos);
  538.             Windows.GetWindowRect(HotKeyTarget, Rect);
  539.  
  540.             TargetX := Rect.left + CaretPos.X;
  541.             TargetY := Rect.top + CaretPos.Y;
  542.         end;
  543.         self.ThreadDetach;
  544.     end;
  545. end;
  546.  
  547. procedure TForm1.ShowPopup(X,Y: integer);
  548. var i: integer;
  549.     m: TMenuItem;
  550.     m2: TMenuItem;
  551.     m2a: TMenuItem;
  552. const SHOW_LEN = 30;
  553.     //
  554.     // create a 1..9, for items 0 to 8 and A to Z for items 9 and so no
  555.     //
  556.     function GetAccelerator(i: integer): char;
  557.     begin
  558.         case (i) of
  559.         0..8: result := chr(byte('1') + i);
  560.         else
  561.             result := chr(byte('A') + (i - 9));
  562.         end;
  563.     end;
  564. begin
  565.     //
  566.     // Recreate the menuitems
  567.     //
  568.     popup.Items.Clear;
  569.  
  570.     if (self.PopupUseKB) then begin
  571.         popup.AutoHotkeys := maAutomatic;
  572.     end else begin
  573.         popup.AutoHotkeys := maManual;
  574.     end;
  575.  
  576.     for i := 0 to lbQueue.Items.count - 1 do begin
  577.         m := TMenuItem.Create(popup);
  578.         if (self.PopupUseKB) then begin
  579.             m.Caption  := '&' + GetAccelerator(i) + ': ' + leftstr(lbQueue.Items[i], SHOW_LEN);
  580.         end else begin
  581.             m.Caption  := leftstr(lbQueue.Items[i], SHOW_LEN);
  582.         end;
  583.  
  584.         m.OnClick := self.MenuItemClickEvent;
  585.         popup.Items.Add(M);
  586.     end;
  587.  
  588.  
  589.     //
  590.     // divider line cancel cancel
  591.     // divider line Last string option
  592.     //
  593.     popup.Items.Add(NewLine());
  594.     m := TMenuItem.Create(popup);
  595.     m.caption := 'Cancel';
  596.     m.OnClick := self.CancelMenuItemClickEvent;
  597.     popup.Items.Add(m);
  598.  
  599.     if (trim(LastStringSelected) <> '') then begin
  600.         popup.Items.Add(Menus.NewLine());
  601.         m := TMenuItem.Create(popup);
  602.         m.caption := 'Last: ' + LeftStr(LastStringSelected, SHOW_LEN);
  603.         m.OnClick := self.LastMenuItemClickEvent;
  604.         popup.Items.Add(m);
  605.     end;
  606.  
  607.  
  608.     if (self.UsePermanentItems) then begin
  609.         popup.Items.Add(menus.NewLine());
  610.         for i := 0 to frmPermanent.GetCount - 1 do begin
  611.             m := TMenuItem.Create(popup);
  612.             m.hint :=    frmPermanent.GetItemName(i);
  613.             m.Caption := m.Hint;
  614.             m.OnClick := self.PermanentMenutItemClickEvent;
  615.             popup.Items.Add(m);
  616.         end;
  617.     end;
  618.  
  619.     //
  620.     // show
  621.     //
  622.     AppendLog('Popup Activated');
  623.     popup.Popup(x, y);
  624.     if GetLastError <> 0 then AppendLog(SysErrorMessage(GetLastError));
  625.     AppendLog('Popup End');
  626. end;
  627.  
  628.  
  629.  
  630.  
  631.  
  632.  
  633. {
  634. --============================
  635. -- // Popup MenuItem Click //
  636. --============================
  637.  
  638. Description: Handle a normal menu item, 'cancel' item, or
  639. 'last' item being clicked. If cancel is not selected mimic keyboard input
  640. into the control with keyboard focus (which is set by the popup menu).
  641.  
  642. Remember the last selected item for the 'last' menu item option.
  643. MenuItem MenuIndex's and the lbQueue index's are the same number.
  644. }
  645. procedure TForm1.MenuItemClickEvent(Sender: TObject);
  646. begin
  647.     with Sender as TMenuItem do begin
  648.         AppendLog( 'menuitem ' + IntToStr(MenuIndex) );
  649.         AppendLog( 'lbQueue.count ' + IntToStr(lbQueue.Count));
  650.  
  651.         LastStringSelected := lbQueue.items[MenuIndex];
  652.  
  653.         AppendLog('inserting text');
  654.         self.SendText(lbQueue.items[MenuIndex]);
  655.         AppendLog('inserting done');
  656.     end;
  657. end;
  658.  
  659. procedure TForm1.LastMenuItemClickEvent(Sender: TObject);
  660. begin
  661.     AppendLog('Inserting last selected string');
  662.     self.SendText(LastStringSelected);
  663. end;
  664.  
  665. procedure TForm1.CancelMenuItemClickEvent(Sender: TObject);
  666. begin
  667.     //
  668.     // since using the keyboard takes away focus from the target
  669.     // window, it must be returned
  670.     //
  671.     if (self.PopupUseKB) then begin
  672.         if (self.ThreadAttach(self.HotKeyForeWindow)) then begin
  673.             Windows.SetForegroundWindow(self.HotKeyForeWindow);
  674.             self.ThreadDetach;
  675.         end;
  676.     end;
  677. end;
  678.  
  679. procedure TForm1.PermanentMenutItemClickEvent(sender: TObject);
  680. begin
  681.     with sender as tmenuitem do begin
  682.         self.SendText( frmPermanent.GetTextFrom( Hint ) );
  683.     end;
  684. end;
  685.  
  686.  
  687. //
  688. // fake a CTRL+V or fake keyboard typing
  689. //
  690. procedure TForm1.SendText(s: string);
  691.     procedure SendUsingKeyboardMimic(s : string);
  692.     var c : char;
  693.         w : word;
  694.         i : integer;
  695.         ShiftPressed, EnterPressed : boolean;
  696.     begin
  697.         for i := 1 to length(s) do begin
  698.             c := s[i];
  699.             w := VkKeyScan(c);
  700.             ShiftPressed := (hi(w) and 1) > 0;
  701.             EnterPressed := (byte(c) = vk_return);
  702.             {VkKeyScan: The first bit of the hi byte set means W means shift is pressed}
  703.  
  704.             {Ditch LF - assume CR came first}
  705.             if (c <> #10) then begin
  706.                 if ShiftPressed and (not EnterPressed) then begin
  707.                     keybd_event(VK_SHIFT, VkKeyScan(char(VK_SHIFT)), 0, 0);
  708.                 end;
  709.  
  710.                 {Press and release key}
  711.                 keybd_event(lo(w), w, 0, 0);
  712.                 keybd_event(lo(w), w, KEYEVENTF_KEYUP, 0);
  713.  
  714.                 if ShiftPressed and (not EnterPressed) then begin
  715.                     keybd_event(VK_SHIFT, VkKeyScan(char(VK_SHIFT)), KEYEVENTF_KEYUP, 0);
  716.                 end;
  717.             end;
  718.  
  719.             if (i mod 10 = 0) then sleep(1); // give the keyboard buffer a little break
  720.         end;
  721.     end;
  722.     procedure SendUsingPaste(s : string);
  723.     var i : integer;
  724.         c : char;
  725.         w : word;
  726.         s2 : string;
  727.     begin
  728.         //
  729.         // place text on clipboard and paste via CTRL+P
  730.         //
  731.  
  732.         AppendLog('clearing and placing selected text on clipboard');
  733.         clipboard.Open;
  734.         clipboard.Clear;
  735.         Clipboard.SetTextBuf(PChar(s));
  736.         clipboard.Close;
  737.         sleep(1);
  738.  
  739.         AppendLog('sending CTRL+V');
  740.         keybd_event(VK_CONTROL , VkKeyScan(char(VK_control)), 0, 0);
  741.         sleep(1);
  742.                 w := VkKeyScan('V');
  743.                 keybd_event(lo(w), w, 0, 0);
  744.                 sleep(1);
  745.  
  746.                 keybd_event(lo(w), w, KEYEVENTF_KEYUP, 0);
  747.                 sleep(1);
  748.         keybd_event(VK_CONTROL , VkKeyScan(char(VK_control)), KEYEVENTF_KEYUP, 0);
  749.         sleep(1);
  750.         AppendLog('sent CTRL+V');
  751.     end;
  752. var s2 : string;
  753. begin
  754.     IgnoreClipboard := true;
  755.     AppendLog('[Paste Start]');
  756.     //
  757.     // Since the popup may have stolen focus from the target,
  758.     // it must be given keyboard focus again
  759.     //
  760.     if (self.PopupUseKB) then begin
  761.         if (self.ThreadAttach(self.HotKeyForeWindow)) then begin
  762.             Windows.SetForegroundWindow(self.HotKeyForeWindow);
  763.             Windows.SetFocus(self.HotKeyTarget);
  764.         end else begin
  765.             showmessage('ERROR: Unable to paste into target');
  766.             exit;
  767.         end;
  768.     end;
  769.  
  770.     if (UseKeyboardMimic) then begin
  771.         SendUsingKeyboardMimic(s);
  772.     end else begin
  773.         SendUsingPaste(s);
  774.     end;
  775.  
  776.     if (self.PopupUseKB) then begin
  777.         self.ThreadDetach;
  778.     end;
  779.  
  780.     AppendLog('[Paste End]');
  781.     IgnoreClipboard := false;
  782. end;
  783.  
  784.  
  785.  
  786.  
  787.  
  788.  
  789. {
  790. --============================
  791. -- // Thead utility methods //
  792. --============================
  793.  
  794. Description: Mimic being part of the targeted window. This method is used
  795. to get the keyboard focused item of an outside process and to associate a
  796. popup menu with an outside process.
  797.  
  798. }
  799.  
  800. function Tform1.ThreadAttach(TargetWindow: cardinal) : boolean;
  801. begin
  802.     result := false;
  803.     If (ThreadAttached) then begin
  804.         showmessage('Error: Thread already attached');
  805.         self.Close;
  806.     end;
  807.  
  808.     ThreadTarget := Windows.GetWindowThreadProcessId(TargetWindow, nil);
  809.     ThreadOurs := Windows.GetCurrentThreadId();
  810.     if (ThreadTarget <> ThreadOurs) then begin
  811.         result := Windows.AttachThreadInput(ThreadTarget, ThreadOurs, true);
  812.         ThreadAttached := true;
  813.     end;
  814. end;
  815. procedure TForm1.ThreadDetach();
  816. begin
  817.     If (not ThreadAttached) then begin
  818.         showmessage('Error: Thread not attached');
  819.         self.Close;
  820.     end;
  821.  
  822.     if (ThreadTarget <> ThreadOurs) then begin
  823.         Windows.AttachThreadInput(ThreadTarget, ThreadOurs, false);
  824.         ThreadAttached := false;
  825.     end;
  826. end;
  827.  
  828.  
  829.  
  830.  
  831. {
  832. --===========
  833. -- // Etc. //
  834. --===========
  835. }
  836. procedure TForm1.AppendLog(s : string);
  837. begin
  838.     if length(memo1.text) > 20000 then memo1.Text := '';
  839.      // Cheezy Debugging Info[tm]
  840.      // make sure we don't overflow the text, only accept 1000 characters
  841.      // at a time
  842.      memo1.Text :=  leftstr(s, 1000) + #13 + #10 + memo1.text;
  843. end;
  844.  
  845.  
  846.  
  847. procedure TForm1.btnHideClick(Sender: TObject);
  848. begin
  849.     self.Hide;
  850. end;
  851.  
  852. end.
  853.