home *** CD-ROM | disk | FTP | other *** search
/ Softwarová Záchrana 3 / Softwarova-zachrana-3.bin / ArsClip / source.zip / UnitFrmClipboardManager.pas < prev    next >
Pascal/Delphi Source File  |  2004-01-24  |  46KB  |  1,492 lines
  1. unit UnitFrmClipboardManager;
  2. {
  3.     Purpose:
  4.     This unit monitors new items on the clipboard.
  5.     Raw data is retrieved and send to the ClipQueue
  6.     (the text, filenames, and icons).
  7.  
  8.     Also, this unit is the interface for the user
  9.     to manipulating the queue.
  10.  
  11.     NOTE:
  12.     Items entering the clipboard too soon after an ArsClip
  13.     paste are ignored, since our clipboard items must be
  14.     ignored.
  15.  
  16. Updates:
  17.     'Fix URL' broken, timing problem and logic problem
  18.  
  19.     -------------------
  20.     If a clip is copied at the same exact time the Clipboard Watcher fires,
  21.     it generates a false clipboard break message.
  22.  
  23.     Fix: GDI object leak when new clipboard item retreival fails
  24.     New Fix URLs option
  25.     Pressing Delete Key to delete items
  26.     -------------------
  27.     Detection of Infinite loop in clipboard chain
  28.     SetIgnoreClipboard now private, not needed elsewhere
  29.     UnitPaste now marks all clips as ours ^^^^^^^^^
  30.  
  31.     ------------------
  32.     edit/preview OtherQueue items
  33.     new 'Copy As' button
  34.  
  35.     -------------
  36.     Updated to save/load icons
  37.     Updated for optional Rich Text monitoring
  38.     
  39.     ----
  40.     Improved error reporting for corrupt data file
  41.  
  42.     Two Icon notifications when an item is copied: normal
  43.     mode, and disabled mode
  44.  
  45.     --
  46.  
  47.     A new method of ignoring the clipboard was needed when another
  48.     program was part of the clipboard viewer chain. When a
  49.     WMDRAWCLIPBOARD message arrives, at least 1 second must have
  50.     passed since the last time FrmMainPopup placed an item on the
  51.     clipboard.
  52.  
  53.     The SetIgnoreClipboard() function is only needed durring
  54.     a paste operation.
  55.  
  56.     Moved the rest of the Queue logic to UnitClipQueue
  57.  
  58.     Copied files no longer causes duplicate entries
  59.  
  60.     lbQueue is not longer used for the clipboard history, due to Win9X
  61.     memory constraints for components. See UnitClipQueue for details.
  62.  
  63. }
  64. interface
  65.  
  66. uses
  67.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  68.   Dialogs, StdCtrls, Clipbrd, ShellAPI, Buttons, ExtCtrls, ComCtrls,
  69.   ImgList {for DragQueryFile};
  70.  
  71. type
  72.   TfrmClipboardManager = class(TForm)
  73.     Panel1: TPanel;
  74.     btnTop: TSpeedButton;
  75.     btnUp: TSpeedButton;
  76.     btnDown: TSpeedButton;
  77.     btnBottom: TSpeedButton;
  78.     Panel2: TPanel;
  79.     btnClose: TButton;
  80.     btnDelete: TButton;
  81.     bCopyToClipboard: TButton;
  82.     PageControl1: TPageControl;
  83.     TabSheet1: TTabSheet;
  84.     TabSheet2: TTabSheet;
  85.     Preview: TLabel;
  86.     mPreview: TMemo;
  87.     lbQueue: TListBox;
  88.     lbNontext: TListBox;
  89.     iPreview: TImage;
  90.     bCopyAs: TButton;
  91.     Label1: TLabel;
  92.     lblClipSize: TLabel;
  93.         procedure FormCreate(Sender: TObject);
  94.         procedure FormDestroy(Sender: TObject);
  95.         procedure btnCloseClick(Sender: TObject);
  96.         procedure btnTopClick(Sender: TObject);
  97.         procedure btnUpClick(Sender: TObject);
  98.         procedure btnDownClick(Sender: TObject);
  99.         procedure btnBottomClick(Sender: TObject);
  100.         procedure btnDeleteClick(Sender: TObject);
  101.         procedure FormClose(Sender: TObject; var Action: TCloseAction);
  102.         procedure FormShow(Sender: TObject);
  103.         procedure lbQueueClick(Sender: TObject);
  104.         procedure bCopyToClipboardClick(Sender: TObject);
  105.         procedure lbQueueDrawItem(Control: TWinControl; Index: Integer;
  106.           Rect: TRect; State: TOwnerDrawState);
  107.         procedure lbQueueMeasureItem(Control: TWinControl; Index: Integer;
  108.           var Height: Integer);
  109.         procedure lbNontextDrawItem(Control: TWinControl; Index: Integer;
  110.           Rect: TRect; State: TOwnerDrawState);
  111.         procedure PageControl1Change(Sender: TObject);
  112.         procedure lbNontextClick(Sender: TObject);
  113.         procedure bCopyAsClick(Sender: TObject);
  114.     procedure lbNontextKeyDown(Sender: TObject; var Key: Word;
  115.       Shift: TShiftState);
  116.     procedure lbQueueKeyDown(Sender: TObject; var Key: Word;
  117.       Shift: TShiftState);
  118.     private
  119.  
  120.  
  121.  
  122.         HistoryLoaded : boolean;
  123.         { Private declarations }
  124.         NextHandle: THandle;                {clipboard chain pointer}
  125.         DisableMonitoring: boolean;         {altered by public interface}
  126.         IgnoreClipboard: boolean;
  127.         MonitorFilenames: boolean;
  128.         MonitorOtherItems: boolean;
  129.         CopyIcon : boolean;
  130.         //LastPaste : TDateTime;
  131.         DisableWhenScrollLock : boolean;
  132.  
  133.         IsJoinedToChain : boolean;
  134.         BypassPasteProtectionOnce : boolean;
  135.  
  136.         function IsSafeToMove : boolean;
  137.         procedure ClipboardChainJoin;
  138.         procedure ClipboardChainLeave;
  139.         procedure SaveTextItemsOrder;
  140.         procedure SaveOtherItemsOrder;
  141.  
  142.         procedure SetIgnoreClipboard(ignore : boolean);
  143.         //procedure InformOfPaste;
  144.         procedure HealBrokenChain;
  145.  
  146.         {windows messages}
  147.         //procedure WMDRAWCLIPBOARD(var Message: TMessage); message WM_DRAWCLIPBOARD;
  148.         procedure WMDRAWCLIPBOARD_NEW(var Message: TMessage); message WM_DRAWCLIPBOARD;
  149.         procedure WMCHANGECBCHAIN(var Message: TMessage); message WM_CHANGECBCHAIN;
  150.  
  151.     public
  152.         { Public declarations }
  153.         CF_RICHTEXT : UINT;
  154.         CF_HTML : UINT;
  155.  
  156.         {configuration}
  157.         procedure SetMonitoring(disable: boolean);
  158.         procedure SetFilenameMonitoring(enable: boolean);
  159.         procedure SetOtherItemsMonitoring(enable: boolean);
  160.         procedure SetCopyIcon(enable: boolean);
  161.         procedure SetDisableWhenScrollLock(value : boolean);
  162.  
  163.         {temporarily ignore the clipboard items}
  164.  
  165.         function GetClipboardOwnerIcon : HICON;
  166.  
  167.         {history load/save}
  168.         //function GetDoSave
  169.         procedure LoadHistory;
  170.         procedure SaveHistory;
  171.  
  172.  
  173.  
  174.         procedure RefreshClipboardMonitor;
  175.  
  176.         function GetIsOnChain : boolean;
  177.   end;
  178.  
  179. var
  180.   frmClipboardManager: TfrmClipboardManager;
  181.  
  182. {////////////////////}
  183. {//}implementation{//}
  184. {////////////////////}
  185.  
  186. uses UnitFrmMainPopup, UnitListBoxMover, UnitFrmDummyIcon,
  187.     UnitClipQueue, UnitOtherQueue, UnitKeyboardQuery, StrUtils, DateUtils,
  188.   UnitFrmSysTrayMenu, UnitFrmChainWatcher, UnitFrmConfig, UnitMisc, Math,
  189.   UnitPaste;
  190. const REMEMBER_FILE = 'remember.txt';
  191. const OTHER_FILE = 'other.txt';
  192.  
  193. {$R *.dfm}
  194.  
  195.  
  196. {
  197. --======================
  198. -- // Public Inteface //
  199. --======================
  200. }
  201. procedure TfrmClipboardManager.RefreshClipboardMonitor;
  202. begin
  203.     Windows.SetLastError(ERROR_SUCCESS);
  204.     self.ClipboardChainLeave;
  205.     self.ClipboardChainJoin;
  206. end;
  207.  
  208. procedure TfrmClipboardManager.HealBrokenChain;
  209. begin
  210.     // this is a bad idea, if the chain is not truely broken
  211.     //
  212.     self.NextHandle := 0;
  213.     self.ClipboardChainJoin; 
  214. end;
  215. {
  216. procedure TFrmClipboardManager.InformOfPaste;
  217. begin
  218.     LastPaste := SysUtils.Time();
  219. end;
  220. }
  221. //--------------------------------
  222. // configuration stuff
  223. //--------------------------------
  224.  
  225. procedure TfrmClipboardManager.SetCopyIcon(enable: boolean);
  226. begin
  227.     self.CopyIcon := enable;
  228. end;
  229. procedure TfrmClipboardManager.SetMonitoring(disable: boolean);
  230. begin
  231.     self.DisableMonitoring := disable;
  232. end;
  233.  
  234. procedure TfrmClipboardManager.SetIgnoreClipboard(ignore : boolean);
  235. begin
  236.     IgnoreClipboard := ignore;
  237.     UnitMisc.AppendLog('ClipboardManager: ignore = ' + BoolToStr(ignore) );
  238. end;
  239.  
  240. procedure TfrmClipboardManager.SetFilenameMonitoring(enable: boolean);
  241. begin
  242.     MonitorFilenames := enable;
  243. end;
  244.  
  245. procedure TFrmClipboardManager.SetOtherItemsMonitoring(enable: boolean);
  246. begin
  247.     MonitorOtherItems := enable;
  248.     if (not enabled) then
  249.         ClipQueue.ClearQueue;
  250. end;
  251.  
  252. procedure TFrmClipboardManager.SetDisableWhenScrollLock(value : boolean);
  253. begin
  254.     DisableWhenScrollLock := value;
  255. end;
  256.  
  257. {
  258. --======================
  259. -- // Create/Destroy  //
  260. --======================
  261. }
  262.  
  263.  
  264. procedure TfrmClipboardManager.FormCreate(Sender: TObject);
  265. begin
  266.     Windows.SetLastError(ERROR_SUCCESS);
  267.  
  268.     self.CF_HTML := RegisterClipboardFormat('HTML Format');
  269.     self.CF_RICHTEXT := RegisterClipboardFormat('Rich Text Format');
  270.     self.ClipboardChainJoin;
  271.     PageControl1.ActivePageIndex := 0;
  272. end;
  273.  
  274. procedure TfrmClipboardManager.FormDestroy(Sender: TObject);
  275. begin
  276.   self.ClipboardChainLeave;
  277. end;
  278.  
  279.  
  280.  
  281.  
  282. {
  283. --=========================
  284. -- // Clipboard messages //
  285. --=========================
  286.  
  287. Description: Monitor for new text entries entered into the clipboard. Add
  288. new text entries into the finite sized queue (removing oldest items as needed).
  289. Also, follow the rule for a change in the clipboard chain.
  290.  
  291. }
  292.  
  293. procedure TfrmClipboardManager.WMDRAWCLIPBOARD_NEW(var Message: TMessage);
  294.  
  295.     // return string when teh clipboard is altered
  296.     function FixedURL(ci : TClipItem) : string;
  297.     var s, s2: string;
  298.         i : integer;
  299.     begin
  300.         result := '';
  301.  
  302.         if (FrmConfig.cbAutofixURLs.Checked) then begin
  303.             s := ci.GetAsText;
  304.             s2 := Trim(s);
  305.  
  306.             i := Pos( '://', s2);
  307.             if (i > 2) and (i < 8) then begin
  308.                 while (Pos(#13#10, s2) <> 0) do begin
  309.                     s2 := StringReplace(s2, #13#10, '', [rfReplaceAll]);
  310.                 end;
  311.  
  312.                 if (s2 <> s) then begin
  313.                     result := s2;
  314.                 end;
  315.             end;
  316.         end;
  317.     end;
  318. var s : string;
  319.     //cTime : TDateTime;
  320.     ClipItem : TClipItem;
  321.     cformat : cardinal;
  322.     URL : string;
  323. label exit_code;
  324. begin
  325.     Windows.SetLastError(ERROR_SUCCESS);
  326.     if (FrmChainWatcher <> nil) then begin
  327.         FrmChainWatcher.NotifyOfClipboardActivity;
  328.         FrmChainWatcher.Disable;
  329.     end;
  330.  
  331.  
  332.     // is this our data that we just pasted?
  333.     // disabled? Ignore the clipboard for now?
  334.     // make sure the data isn't from us
  335.     // configurable disable via Scroll Lock key
  336.  
  337.     {CTime := SysUtils.Time();
  338.     if ((MillisecondOfTheDay(CTime) - MillisecondOfTheDay(LastPaste)) < 100) then begin
  339.         UnitMisc.AppendLog('    Too soon a paste message - ignoring');
  340.         goto exit_code;
  341.     end;
  342.     }
  343.     if (DisableMonitoring) then begin
  344.         frmSysTrayMenu.SetIconIgnore;
  345.         UnitMisc.AppendLog('//// Monitoring disabled');
  346.         goto exit_code;
  347.     end;
  348.  
  349.     if (IgnoreClipboard) then begin
  350.         UnitMisc.AppendLog('//// Ignoring ');
  351.         goto exit_code;
  352.     end;
  353.  
  354.     if (Windows.GetClipboardOwner = Application.Handle) and
  355.        not (self.BypassPasteProtectionOnce)   then begin
  356.         UnitMisc.AppendLog('    Ignore our own clipboard events');
  357.         goto exit_code;
  358.     end;
  359.     self.BypassPasteProtectionOnce := false;
  360.  
  361.     If (self.DisableWhenScrollLock) then begin
  362.         if (KeyboardQuery.LockOn(VK_SCROLL)) then begin
  363.             frmSysTrayMenu.SetIconIgnore;
  364.  
  365.             UnitMisc.AppendLog('    scroll lock on - ignoring contents');
  366.             goto exit_code;
  367.         end;
  368.     end;
  369.  
  370.     // get ready to do the thing
  371.     IgnoreClipboard := true;
  372.     UnitMisc.AppendLog('//// Clipboard Start ////' +
  373.         #13+#10 +
  374.         '    # = ' + IntToStr(message.msg) +
  375.         ' lparam = ' + IntToStr(message.LParam) +
  376.         ' wparam = ' + IntToStr(message.WParam)
  377.     );
  378.  
  379.  
  380.     frmSysTrayMenu.SetIconTriggered;
  381.     //
  382.     // Clipboard contents have changed
  383.     // Copy the contents
  384.     //
  385.     cformat := 0;
  386.     try
  387.         ClipItem := TClipItem.Create;
  388.         UnitMisc.AppendLog('    Attempting to retrieve clipboard text');
  389.         // get clipboard item
  390.         // only act when an item is found (non-zero result) without error
  391.         if (CopyIcon) then begin
  392.             cformat := ClipItem.GetClipboardItem(self.GetClipboardOwnerIcon);
  393.         end else begin
  394.             cformat := ClipItem.GetClipboardItem(0);
  395.         end;
  396.     except
  397.         on E: Exception do
  398.         begin
  399.             UnitMisc.AppendLog('problems getting new clip item: ' + e.message);
  400.         end;
  401.     end;
  402.  
  403.     // FIX: Don't leak GDI memory when object retreval fails
  404.     if (cformat = 0) then begin
  405.         UnitMisc.AppendLog('Get ClipItem failed',true);
  406.         MyDestroyIcon(ClipItem.CData.GetHICONAbsolute);
  407.         MyFree(ClipItem);
  408.         IgnoreClipboard := false;
  409.         goto exit_code;
  410.     end;
  411.  
  412.     // Detect broken URLs
  413.     // - abort process when detected
  414.     URL := FixedURL(ClipItem);
  415.     if (FixedUrl(ClipItem) <> '') then begin
  416.         MyFree(ClipItem);
  417.         IgnoreClipboard := false;
  418.         goto exit_code;
  419.     end;
  420.  
  421.     try
  422.         if (cformat <> 0) then begin
  423.             s := ClipItem.GetAsText;
  424.  
  425.             // May be a text item, may be a copied filename,
  426.             // may be an "Other" item
  427.             // Will be deleted if nobody wants the clip
  428.             if (s <> '') then begin
  429.                 if (CFormat = Windows.CF_HDROP) then begin
  430.                     if (MonitorFilenames) then begin
  431.                         if (s <> '') then begin
  432.                             UnitMisc.AppendLog('    Accepting as file(s)');
  433.                             ClipQueue.InsertAtStart(ClipItem);
  434.                         end else begin
  435.                             UnitMisc.AppendLog('    Nobody wants the clip');
  436.                             MyFree(ClipItem);
  437.                         end;
  438.                     end;
  439.                 end else begin
  440.                     UnitMisc.AppendLog('    Accepting as text');
  441.                     ClipQueue.InsertAtStart(ClipItem);
  442.                 end;
  443.  
  444.             end else begin
  445.                 if (self.MonitorOtherItems)then begin
  446.                     UnitMisc.AppendLog('    Accepting as Other clip');
  447.                     OtherQueue.InsertAtStart(ClipItem);
  448.                 end else begin
  449.                     UnitMisc.AppendLog('    Nobody wants the clip');
  450.                     MyFree(ClipItem);
  451.                 end;
  452.             end;
  453.         end;
  454.     except
  455.         on E: Exception do
  456.         begin
  457.             UnitMisc.AppendLog('problems getting new clip item: ' + e.message);
  458.         end;
  459.     end;
  460.  
  461.  
  462.     IgnoreClipboard := false;
  463. exit_code:
  464.  
  465.     // Pass message to next in line (rules of a cliboard viewer)
  466.     Message.Result := 0;
  467.     If (NextHandle <> 0) then begin
  468.         if (NextHandle = self.Handle) then begin
  469.             NextHandle := 0;
  470.             UnitMisc.AppendLog('Infinite loop detected in Clipboard chain!!!');
  471.         end else begin
  472.             Windows.SendMessage(NextHandle, WM_DRAWCLIPBOARD,  message.WParam, message.LParam )
  473.         end;
  474.     end;
  475.     UnitMisc.AppendLog('//// Clipboard End ////');
  476.     if (FrmChainWatcher <> nil) then begin
  477.         FrmChainWatcher.Enable;
  478.     end;
  479.  
  480.     if (URL <> '') then begin
  481.         UnitMisc.AppendLog('//// Fixing URL');
  482.         self.BypassPasteProtectionOnce := true;
  483.         Paste.PlaceOnClipboardDontBypassClipboardManager(URL);
  484.         UnitMisc.TimerStart;
  485.         UnitMisc.TimerEndAt(50); 
  486.     end;
  487. end;
  488.  
  489. {
  490. procedure TfrmClipboardManager.WMDRAWCLIPBOARD(var Message: TMessage);
  491. var s : string;
  492.     cTime : TDateTime;
  493. label exit_code;
  494.  
  495.     function GetClipboardText(GetAsRichText : boolean = false): string;
  496.     var hnd : THandle;
  497.         p : Pointer;
  498.  
  499.         format : UINT;
  500.         formatFound : boolean;
  501.     begin
  502.         // This code is an attemp to get rid of the "Cannot Open Clipboard"
  503.         // errors. The previous version of this code caused garbage to appear
  504.         // in the history.
  505.         result := '';
  506.         p := nil;
  507.         hnd := 0;
  508.         try
  509.             formatFound := false;
  510.             format := 0;
  511.  
  512.  
  513.             if (Clipboard.HasFormat(CF_RICHTEXT) and GetAsRichText) then begin
  514.                 format := CF_RICHTEXT;
  515.                 formatFound := true;
  516.             end else if (clipboard.HasFormat(CF_TEXT) and Not GetAsRichText) then begin
  517.                 format := CF_TEXT;
  518.                 formatFound := true;
  519.             end;
  520.             if (formatFound) then begin
  521.                 UnitMisc.AppendLog('open clipboard');
  522.                 if (Windows.OpenClipboard(Application.Handle)) then begin
  523.                     hnd := Windows.GetClipboardData(format);
  524.                     if (hnd <> 0)  then begin
  525.                         p := GlobalLock(hnd);
  526.                         if (p <> nil) then begin
  527.                             result := PChar(p);
  528.                         end else begin
  529.                             UnitMisc.AppendLog('ERROR: failed to lock clipboard data');
  530.                         end;
  531.                     end else begin
  532.                         UnitMisc.AppendLog('ERROR: GetClipboardData() : ' + SysErrorMessage(GetLastError()) );
  533.                     end;
  534.                     Windows.CloseClipboard;
  535.                 end else begin
  536.                     UnitMisc.AppendLog('ERROR: Failed to open clipboard: ' + SysErrorMessage(GetLastError()) );
  537.                 end;
  538.             end;
  539.         finally
  540.             if (p <> nil) and (hnd <> 0) then begin
  541.                 Windows.GlobalUnlock(hnd);
  542.                 UnitMisc.AppendLog('closing lock');
  543.             end else begin
  544.                 UnitMisc.AppendLog('not closing lock');
  545.             end;
  546.         end;
  547.  
  548.     end;
  549.  
  550.     //
  551.     // return all filenames or return empty string
  552.     function GetFilenames: string;
  553.     var h, lockdata : THandle;
  554.         i, j : longint;
  555.         s : string;
  556.     begin
  557.         result := '';
  558.  
  559.         if (MonitorFilenames) then begin
  560.             if (clipboard.HasFormat(CF_HDROP)) then begin
  561.                 UnitMisc.AppendLog('    Detecting Filenames...');
  562.  
  563.                 // only attemp after a global lock has been made
  564.                 h := clipboard.GetAsHandle(CF_HDROP);
  565.                 lockdata := THandle(Windows.GlobalLock(h));
  566.                 if (lockdata <> 0) then begin
  567.                     j := ShellApi.DragQueryFile(lockdata, $FFFFFFFF, nil, 0);
  568.  
  569.                     result := '';
  570.                     for i := 0 to (j - 1) do begin
  571.                         s := stringofchar(' ', Windows.MAX_PATH);
  572.                         ShellApi.DragQueryFile(lockdata, i, pchar(s), length(s));
  573.                         UnitMisc.AppendLog(Trim(String(s)));
  574.                         if i = (j - 1) then begin
  575.                             result := result + Trim(PChar(s));
  576.                         end else begin
  577.                             result := result + Trim(PChar(s)) + #13 + #10;
  578.                         end;
  579.                     end;
  580.  
  581.                     Windows.GlobalUnlock(lockdata);
  582.                 end;
  583.             end;
  584.         end;
  585.     end;
  586. var RichText : string;
  587. begin
  588.     if (FrmChainWatcher <> nil) then begin
  589.         FrmChainWatcher.NotifyOfClipboardActivity;
  590.     end;
  591.  
  592.     // is this our data that we just pasted?
  593.     // disabled? Ignore the clipboard for now?
  594.     // make sure the data isn't from us
  595.     // configurable disable via Scroll Lock key
  596.  
  597.     CTime := SysUtils.Time();
  598.     if ((MillisecondOfTheDay(CTime) - MillisecondOfTheDay(LastPaste)) < 300) then begin
  599.         UnitMisc.AppendLog('    Too soon a paste message - ignoring');
  600.         goto exit_code;
  601.     end;
  602.  
  603.     if (DisableMonitoring) then begin
  604.         frmSysTrayMenu.SetIconIgnore;
  605.         UnitMisc.AppendLog('//// Monitoring disabled');
  606.         goto exit_code;
  607.     end;
  608.     if (IgnoreClipboard) then begin
  609.         UnitMisc.AppendLog('//// Ignoring ');
  610.         goto exit_code;
  611.     end;
  612.  
  613.     if (Windows.GetClipboardOwner = self.Handle) then begin
  614.         UnitMisc.AppendLog('    Ignore our own clipboard events');
  615.         goto exit_code;
  616.     end;
  617.  
  618.     If (self.DisableWhenScrollLock) then begin
  619.         if (KeyboardQuery.LockOn(VK_SCROLL)) then begin
  620.             frmSysTrayMenu.SetIconIgnore;
  621.  
  622.             UnitMisc.AppendLog('    scroll lock on - ignoring contents');
  623.             goto exit_code;
  624.         end;
  625.     end;
  626.  
  627.     // get ready to do the thing
  628.     IgnoreClipboard := true;
  629.     UnitMisc.AppendLog('//// Clipboard Start ////' +
  630.         #13+#10 +
  631.         '    # = ' + IntToStr(message.msg) +
  632.         ' lparam = ' + IntToStr(message.LParam) +
  633.         ' wparam = ' + IntToStr(message.WParam)
  634.     );
  635.  
  636.  
  637.     frmSysTrayMenu.SetIconTriggered;
  638.     //
  639.     // Clipboard contents have changed
  640.     // Copy the contents if it is text
  641.     try
  642.         UnitMisc.AppendLog('    Attempting to retrieve clipboard text');
  643.         s := GetClipboardText;
  644.  
  645.         if (s = '') then begin
  646.             // check for filenames
  647.             UnitMisc.AppendLog('    Empty string in clipboard or error retreiving text.');
  648.             s := GetFilenames();
  649.             if (s = '') and (self.MonitorOtherItems) then begin
  650.                 if (CopyIcon) then begin
  651.                     OtherQueue.ClipboardSave(self.GetClipboardOwnerIcon);
  652.                 end else begin
  653.                     OtherQueue.ClipboardSave(HICON(nil));
  654.                 end;
  655.             end;
  656.         end;
  657.  
  658.         // trim the queue size, dup oldest entry
  659.         if (s <> '') then begin
  660.             ClipQueue.InsertAtStart(ClipItem);
  661.  
  662.             if (CopyIcon) then begin
  663.  
  664.                 if FrmConfig.cbMonitorRichTextItems.checked then begin
  665.                     RichText := GetClipboardText(true);
  666.                 end else begin
  667.                     RichText := '';
  668.                 end;
  669.  
  670.                 if (RichText = '') then begin
  671.                     Clip
  672.                     ClipQueue.InsertAtStart(s, self.GetClipboardOwnerIcon);
  673.                 end else begin
  674.                     ClipQueue.InsertAtStart(s, RichText, self.GetClipboardOwnerIcon);
  675.                 end;
  676.             end else begin
  677.                 ClipQueue.InsertAtStart(s, HICON(nil));
  678.             end;
  679.         end;
  680.     finally
  681.  
  682.     end;
  683.  
  684.  
  685.     IgnoreClipboard := false;
  686. exit_code:
  687.     // Pass message to next in line (rules of a cliboard viewer)
  688.     Message.Result := 0;
  689.     If (NextHandle <> 0) then begin
  690.         Windows.SendMessage(NextHandle, WM_DRAWCLIPBOARD,  message.WParam, message.LParam )
  691.     end;
  692.     UnitMisc.AppendLog('//// Clipboard End ////');
  693. end;
  694. }
  695.  
  696. procedure TfrmClipboardManager.WMCHANGECBCHAIN(var Message: TMessage);
  697. begin
  698.     Windows.SetLastError(ERROR_SUCCESS);
  699.  
  700.     //
  701.     //Someone is leaving the chain, only "fires" when the program leaving
  702.     //is the one after us
  703.     //
  704.  
  705.     { MS Documentation...
  706.     When a clipboard viewer window receives the WM_CHANGECBCHAIN message,
  707.     it should call the SendMessage function to pass the message to the
  708.     next window in the chain, unless the next window is the window being
  709.     removed. In this case, the clipboard viewer should save the handle
  710.     specified by the lParam parameter as the next window in the chain.
  711.     }
  712.     if (Cardinal(Message.WParam) = NextHandle) then begin
  713.         UnitMisc.AppendLog('WM_Changecbchain - reassign next handle');
  714.         NextHandle := Message.LParam;
  715.  
  716.         if (NextHandle = self.Handle) then begin
  717.             Raise Exception.Create('ERROR: ArsClip Joined the chain twice!');
  718.         end;
  719.     end else if (NextHandle <> 0) then begin
  720.         UnitMisc.AppendLog('WM_Changecbchain - send message to next handle');
  721.         if NextHandle <> 0 then
  722.             sendmessage(NextHandle,
  723.                         WM_CHANGECBCHAIN,
  724.                         Message.WParam,  // handle of window to remove
  725.                         Message.LParam); // handle of next window
  726.     end;
  727.  
  728.     //
  729.     // viewers joining/leaving the chain can send erounious 'clipboard
  730.     // changed' events, so they'll need to be ingored just like our own
  731.     // paste events
  732.  
  733.     //self.InformOfPaste;
  734.     Message.Result := 0;
  735. end;
  736.  
  737. procedure TfrmClipboardManager.ClipboardChainJoin;
  738. var i : integer;
  739. begin
  740.     Windows.SetLastError(ERROR_SUCCESS);
  741.  
  742.     //Join the cliboard chain
  743.     // Disable monitoring until this form has been created
  744.     // This prevents aditions until the Config form has a
  745.     // chance to set the queue size
  746.  
  747.     self.SetIgnoreClipboard(true);
  748.     UnitMisc.AppendLog('ClipManager: Joining Chain');
  749.     Windows.SetLastError(ERROR_SUCCESS);
  750.  
  751.     if not Windows.OpenClipboard(Application.Handle) then begin
  752.         UnitMisc.AppendLog('Can''t open clipboard', true);
  753.         EXIT;
  754.     end;
  755.     NextHandle := Windows.SetClipboardViewer(self.Handle);
  756.  
  757.     if (NextHandle = 0) then begin
  758.  
  759.         i := Windows.GetLastError;
  760.         if (i <> 0) then begin
  761.             UnitMisc.AppendLog('ClipManager: Can''t join chain ' + SysErrorMessage(i) );
  762.             self.IsJoinedToChain := false;
  763.         end else begin
  764.             self.IsJoinedToChain := true;
  765.         end;
  766.     end else begin
  767.         self.IsJoinedToChain := true;
  768.     end;
  769.  
  770.     Windows.CloseClipboard;
  771.  
  772.     UnitMisc.AppendLog('ClipManger: joining end');
  773.     self.SetIgnoreClipboard(false);
  774. end;
  775. procedure TfrmClipboardManager.ClipboardChainLeave;
  776. begin
  777.     Windows.SetLastError(ERROR_SUCCESS);
  778.  
  779.     self.IsJoinedToChain := false;
  780.     self.SetIgnoreClipboard(true);
  781.     UnitMisc.AppendLog('ClipManager: leaving chain');
  782.     //Leave the chain
  783.  
  784.     Windows.ChangeClipboardChain(self.Handle,     // our handle to remove
  785.                    NextHandle ); // handle of next window in the chain
  786.  
  787.     UnitMisc.AppendLog('ClipManger: leaving end');
  788.     self.SetIgnoreClipboard(false);
  789. end;
  790.  
  791.  
  792.  
  793.  
  794.  
  795.  
  796.  
  797.  
  798.  
  799. procedure TfrmClipboardManager.LoadHistory;
  800. var base, icons, otherclips, textclips, name, itemText, s : string;
  801.     lineCount : cardinal;
  802.     i , IconCount: integer;
  803.     tf : textfile;
  804.     ci : TClipItem;
  805. begin
  806.     // only load once
  807.     if (HistoryLoaded) then begin
  808.         exit;
  809.     end;
  810.     HistoryLoaded := true;
  811.     //
  812.     // load permanent items
  813.     //
  814.     base := IncludeTrailingPathDelimiter(ExtractFilePath(application.ExeName));
  815.     name := base + REMEMBER_FILE;
  816.     icons := base + 'iconcache\';
  817.     textclips := base + 'textcache\';
  818.     otherclips := base + 'othercache\';
  819.  
  820.     if FileExists(name) then begin
  821.         AssignFile(tf, name);
  822.         Reset(tf, name);
  823.  
  824.         ClipQueue.ClearQueue;
  825.  
  826.         //
  827.         // abort reading and show message on error
  828.         // always close the file
  829.         //
  830.         try
  831.             iconCount := 0;
  832.             while not eof(tf) do begin
  833.                 try
  834.                     Readln(tf, s);
  835.                     itemText := '';
  836.                     lineCount := StrToInt(s);
  837.  
  838.                     for i := 0 to lineCount - 1 do begin
  839.                         Readln(tf, s);
  840.                         if (itemText = '') then begin
  841.                             itemText := s;
  842.                         end else begin
  843.                             itemText := itemText + #13#10 + s;
  844.                         end;
  845.                     end;
  846.                     ci := TClipItem.Create;
  847.                     ci.CData.SetString(itemText);
  848.  
  849.                     // load icon if exists
  850.                     ci.LoadIconFromFile(icons, iconCount);
  851.                     ci.LoadFromFIle(textClips, IconCount);
  852.  
  853.                     ClipQueue.AddNoSizeCheck(itemText, ci);
  854.                     inc(IconCount);
  855.                 except
  856.                     on E: Exception do begin
  857.                         ShowMessage('The "Load items from last session" file is corrupted - ' + name + #13#10#13#10 +
  858.                                     'Error Message: ' + E.Message);
  859.                         break;
  860.                     end;
  861.                 end;
  862.             end;
  863.  
  864.         finally
  865.             CloseFile(tf);
  866.         end;
  867.     end;
  868.  
  869.     //
  870.     // load the
  871.     //
  872.     name := base + OTHER_FILE;
  873.     if (FileExists(name)) then begin
  874.         AssignFile(tf, name);
  875.         reset(tf);
  876.         i := 0;
  877.         while not eof(tf) do begin
  878.             readln(tf,s);
  879.             ci := TClipItem.Create;
  880.             ci.CData.SetString(s);
  881.             ci.LoadFromFIle(otherclips, i);
  882.             ci.LoadIconFromFile(icons, i, '-o');
  883.             OtherQueue.AddNoSizeCheck(s, ci);
  884.             inc(i);
  885.         end;
  886.         closefile(tf);
  887.     end;
  888. end;
  889.  
  890. procedure TfrmClipboardManager.SaveHistory;
  891. var base, name, icons, otherclips, textclips, s : string;
  892.     i, j, cnt : integer;
  893.     tf: textfile;
  894.     ci : TClipItem;
  895.     ico : TIcon;
  896.     bit : TBitmap;
  897.     r : TRect;
  898. begin
  899.     //
  900.     // save items
  901.     //
  902.     base := IncludeTrailingPathDelimiter(ExtractFilePath(application.ExeName));
  903.     name :=  base + REMEMBER_FILE;
  904.     icons := base + 'iconcache\';
  905.     ForceDirectories(icons);
  906.     textclips := base + 'textcache\';
  907.     ForceDirectories(textclips);
  908.     otherclips := base + 'othercache\';
  909.     ForceDirectories(otherclips);
  910.  
  911.     AssignFile(tf, name);
  912.     Rewrite(tf);
  913.     ico := TIcon.Create;
  914.     bit := TBitmap.Create;
  915.     r.Top := 0;
  916.     r.Left := 0;
  917.     r.bottom := 15;
  918.     r.Right := 15;
  919.     for i := 0 to (ClipQueue.GetQueueCount - 1) do begin
  920.         // ultra cheap trick[tm] to count lines in an item
  921.         // FIX: Count CR+LF instead of just CR
  922.         cnt := 1;
  923.  
  924.         s := ClipQueue.GetItemText(i);
  925.         for j := 1 to length(s) - 1 do begin
  926.             if (s[j] = #13) and (s[j+1]= #10) then inc(cnt);
  927.         end;
  928.  
  929.         //
  930.         // save or overwrite the icon file
  931.         // save or overwrite the clip item
  932.         //
  933.         ci := ClipQueue.GetClipItem(i);
  934.         if (ci <> nil) then begin
  935.             ci.SaveIconToFile(icons, i);
  936.             ci.SaveToFile(textclips, i)
  937.         end;
  938.  
  939.         writeln(tf, cnt);
  940.         writeln(tf, s);
  941.     end;
  942.     CloseFile(tf);
  943.  
  944.     //
  945.     // save the other items
  946.     // and their icons
  947.     //
  948.     AssignFile(tf, base + OTHER_FILE);
  949.     Rewrite(tf);
  950.     for i := 0 to (OtherQueue.GetQueueCount - 1) do begin
  951.         ci := OtherQueue.GetClipItem(i);
  952.         writeln(tf, ci.GetAsText);
  953.         ci.SaveToFile(otherclips, i);
  954.         ci.SaveIconToFile(icons, i, '-o');
  955.     end;
  956.     CloseFile(tf);
  957.  
  958.     MyFree(ico);
  959.     MyFree(bit);
  960. end;
  961.  
  962.  
  963.  
  964.  
  965. function TFrmClipboardManager.GetClipboardOwnerIcon() : HICON;
  966. var h, owner : THandle;
  967.  
  968.     // NOTE: DestroyIcon must before deleting a queued item!!!!!
  969.     {
  970.     // CopyIcon seems to leak GDI objects
  971.     function CloneIcon(inIcon : HICON) : HICON;
  972.     begin
  973.         // talk about a simple replacement!
  974.         Result := Windows.CopyIcon(inIcon);
  975.     end;
  976.     }
  977.     function CloneIcon(inIcon : HICON) : HICON;
  978.     var hIconNew : HICON;
  979.         info : _ICONINFO;
  980.     begin
  981.         result := 0;
  982.  
  983.         // info from PCMagazine's TrayManager
  984.         // Get information about the specified icon
  985.         // Create a clone of the icon
  986.  
  987.         if (not Windows.GetIconInfo(inIcon, info)) then begin
  988.             frmMainPopup.AppendLog('clone icon: ' + SysErrorMessage(GetLastError));
  989.             EXIT;
  990.         end;
  991.  
  992.         hIconNew := Windows.CreateIconIndirect(info);
  993.         if (hIconNew = 0) then begin
  994.             frmMainPopup.AppendLog('CreateIconIndirect failed: ' + SysErrorMessage(GetLastError));
  995.         end;
  996.  
  997.         // Delete the info item's bitmaps -- otherwise we get a very
  998.         // ugly memory leak
  999.         if (not Windows.DeleteObject(info.hbmMask)) then begin
  1000.             frmMainPopup.AppendLog('DeleteObject failed: ' + SysErrorMessage(GetLastError));
  1001.         end;
  1002.         if (not Windows.DeleteObject(info.hbmColor)) then begin
  1003.             frmMainPopup.AppendLog('DeleteObject failed: ' + SysErrorMessage(GetLastError));
  1004.         end;
  1005.         result := hIconNew;
  1006.  
  1007.     end;
  1008. begin
  1009.     Windows.SetLastError(ERROR_SUCCESS);
  1010.     
  1011.     // set defualt result
  1012.     // bail out if owner went bye-bye
  1013.     result := 0;
  1014.     owner := Windows.GetForegroundWindow;
  1015.     if (owner = 0) then begin
  1016.         EXIT;
  1017.     end;
  1018.  
  1019.     UnitMisc.AppendLog('^Cloning Icon^');
  1020.     // find topmost parent
  1021.     repeat
  1022.         h := GetWindowLong(owner, GWL_HWNDPARENT);
  1023.         if (h <> 0) then begin
  1024.             {
  1025.             // may be used in the future to identifiy CLIPBRDWNDCLASS
  1026.  
  1027.             s := StringOfChar(#0, 255);
  1028.             if GetClassName(owner, pchar(s), length(s)-1) <> 0 then begin
  1029.                 // CLIPBRDWNDCLASS will return nothing
  1030.                 // wonder what that bastard class actually is
  1031.             end;
  1032.             }
  1033.             owner := h;
  1034.         end;
  1035.     until (h = 0);
  1036.     Windows.SetLastError(ERROR_SUCCESS);
  1037.  
  1038.     // get the first small icon available, if any
  1039.     h := Windows.GetClassLong(owner, GCL_HICONSM);
  1040.     if (h <> 0) then begin
  1041.         result := CloneIcon(h);
  1042.         EXIT;
  1043.     end;
  1044.     Windows.SetLastError(ERROR_SUCCESS);
  1045.  
  1046.     h := Windows.GetClassLong(owner, GCL_HICON);
  1047.     if (h <> 0) then begin
  1048.         result := CloneIcon(h);
  1049.         EXIT;
  1050.     end;
  1051.     Windows.SetLastError(ERROR_SUCCESS);
  1052.  
  1053.     if (SendMessageTimeout(owner, WM_GETICON, ICON_SMALL,0,SMTO_ABORTIFHUNG,1000,h) <> 0) then begin
  1054.         result := CloneIcon(h);
  1055.         EXIT;
  1056.     end;
  1057.     Windows.SetLastError(ERROR_SUCCESS);
  1058.  
  1059.     if (SendMessageTimeout(owner, WM_GETICON, ICON_BIG,0,SMTO_ABORTIFHUNG,1000,h) <> 0) then begin
  1060.         result := CloneIcon(h);
  1061.         EXIT;
  1062.     end;
  1063.     Windows.SetLastError(ERROR_SUCCESS);
  1064.  
  1065.     UnitMisc.AppendLog('Clone failed: ' + SysUtils.SysErrorMessage(Windows.GetLastError));
  1066. end;
  1067.  
  1068.  
  1069.  
  1070.  
  1071.  
  1072. //////////////////////////////////////////////////////////////
  1073. // User Interface
  1074. // close the window,
  1075. // move item
  1076. // delete item
  1077. //////////////////////////////////////////////////////////////
  1078.  
  1079. procedure TfrmClipboardManager.btnCloseClick(Sender: TObject);
  1080. begin
  1081.     self.ModalResult := mrok;
  1082.     self.close;
  1083. end;
  1084.  
  1085. function TfrmClipboardManager.IsSafeToMove: boolean;
  1086. var ci : TClipItem;
  1087. begin
  1088.     if (lbQueue.Count = 0) then begin
  1089.         Result := true;
  1090.         EXIT;
  1091.     end;
  1092.  
  1093.     ci := TClipItem(self.lbQueue.Items.Objects[0]);
  1094.     result := (ClipQueue.IndexOf(ci) = 0);
  1095.     if (not result) then begin
  1096.         ShowMessage('The clipboard contents have changed. Unable to move the items.'
  1097.             + #13#10 + 'Refreshing display');
  1098.         self.FormShow(self);
  1099.     end;
  1100. end;
  1101.  
  1102.  
  1103. procedure TfrmClipboardManager.btnTopClick(Sender: TObject);
  1104. begin
  1105.     if (PageControl1.ActivePageIndex = 0) then begin
  1106.         if (IsSafeToMove) then begin
  1107.             UnitListBoxMover.MoveSelectedTop(lbQueue);
  1108.             self.SaveTextItemsOrder;
  1109.         end;
  1110.     end else begin
  1111.         UnitListBoxMover.MoveSelectedTop(lbNontext);
  1112.         self.SaveOtherItemsOrder;
  1113.     end;
  1114. end;
  1115.  
  1116. procedure TfrmClipboardManager.btnUpClick(Sender: TObject);
  1117. begin
  1118.     if (PageControl1.ActivePageIndex = 0) then begin
  1119.         if (IsSafeToMove) then begin
  1120.             UnitListBoxMover.MoveSelectedUp(lbQueue);
  1121.             self.SaveTextItemsOrder;
  1122.         end;
  1123.     end else begin
  1124.         UnitListBoxMover.MoveSelectedUp(lbNontext);
  1125.         self.SaveOtherItemsOrder;
  1126.     end;
  1127.  
  1128. end;
  1129.  
  1130. procedure TfrmClipboardManager.btnDownClick(Sender: TObject);
  1131. begin
  1132.     if (PageControl1.ActivePageIndex = 0) then begin
  1133.         if (IsSafeToMove) then begin
  1134.             UnitListBoxMover.MoveSelectedDown(lbQueue);
  1135.             self.SaveTextItemsOrder;
  1136.         end;
  1137.     end else begin
  1138.         UnitListBoxMover.MoveSelectedDown(lbNontext);
  1139.         self.SaveOtherItemsOrder;
  1140.     end;
  1141.  
  1142. end;
  1143.  
  1144. procedure TfrmClipboardManager.btnBottomClick(Sender: TObject);
  1145. begin
  1146.     if (PageControl1.ActivePageIndex = 0) then begin
  1147.         if (IsSafeToMove) then begin
  1148.             UnitListBoxMover.MoveSelectedBottom(lbQueue);
  1149.             self.SaveTextItemsOrder;
  1150.         end;
  1151.     end else begin
  1152.         UnitListBoxMover.MoveSelectedBottom(lbNontext);
  1153.         self.SaveOtherItemsOrder;
  1154.     end;
  1155.  
  1156. end;
  1157.  
  1158. procedure TfrmClipboardManager.btnDeleteClick(Sender: TObject);
  1159. var i, j : integer;
  1160.     ci : TClipItem;
  1161. begin
  1162.     if KeyboardQuery.IsPressed(VK_CONTROL) then begin
  1163.         self.HealBrokenChain;
  1164.         // Purposely KILL THE PROGRAM
  1165.     end;
  1166.  
  1167.     if (PageControl1.ActivePageIndex = 0) then begin
  1168.         for i := (lbqueue.Items.count - 1) downto 0 do begin
  1169.             if (lbqueue.Selected[i]) then begin
  1170.                 ci := TClipItem(lbQueue.Items.Objects[i]);
  1171.                 j := ClipQueue.IndexOf(ci);
  1172.  
  1173.                 ClipQueue.DeleteItem(j);
  1174.                 lbQueue.Items.Delete(i);
  1175.             end;
  1176.         end;
  1177.     end else begin
  1178.         for i := (lbnontext.Items.count - 1) downto 0 do begin
  1179.             if (lbnontext.Selected[i]) then begin
  1180.                 ci := TClipItem(lbNontext.Items.Objects[i]);
  1181.                 j := OtherQueue.IndexOf(ci);
  1182.  
  1183.                 lbnontext.Items.Delete(i);
  1184.                 OtherQueue.DeleteItem(j);
  1185.             end;
  1186.         end;
  1187.     end;
  1188. end;
  1189.  
  1190.  
  1191. //------------------------------------------------------------------
  1192. // To set the changes in the queue, send back what we've altered
  1193. //
  1194. // NOTE: See the dirty trick used as a Win9X workaround
  1195. // A reference to the ClipItem of each listbox item is stored.
  1196. // This is how each item's index can be found in ClipQueue and
  1197. // OtherQueue
  1198. //------------------------------------------------------------------
  1199. procedure TfrmClipboardManager.FormClose(Sender: TObject;
  1200.   var Action: TCloseAction);
  1201. begin
  1202.     bCopyAs.Visible := false;
  1203.     lbNontext.Clear;
  1204.     lbQueue.Clear;
  1205. end;
  1206.  
  1207. procedure TfrmClipboardManager.SaveOtherItemsOrder;
  1208. var i, index : longint;
  1209.     ci : TClipItem;
  1210. begin
  1211.     //
  1212.     // recreate the order as seen in the form
  1213.     //
  1214.     for i := (lbNontext.Items.count - 1) downto 0 do begin
  1215.         ci := TClipItem(lbNontext.items.Objects[i]);
  1216.         index := OtherQueue.IndexOf(ci);
  1217.         if (i <> index) then begin
  1218.             OtherQueue.Move(index, i);
  1219.         end;
  1220.     end;
  1221. end;
  1222. procedure TfrmClipboardManager.SaveTextItemsOrder;
  1223. var i, index : longint;
  1224.     ci : TClipItem;
  1225. begin
  1226.     for i := (lbQueue.Items.count - 1) downto 0 do begin
  1227.         ci := TClipItem(lbQueue.items.Objects[i]);
  1228.         index := ClipQueue.IndexOf(ci);
  1229.         if (i <> index) then begin
  1230.             ClipQueue.Move(index, i);
  1231.         end;
  1232.     end;
  1233. end;
  1234.  
  1235.  
  1236. procedure TfrmClipboardManager.FormShow(Sender: TObject);
  1237.     procedure AddItems(clips : TClipQueue; listbox : TListBox);
  1238.     var i : integer;
  1239.         s : string;
  1240.         ci : TClipItem;
  1241.     begin
  1242.         for i := 0 to (clips.GetQueueCount - 1) do begin
  1243.             ci := clips.GetClipItem(i);
  1244.             s := ci.GetAsText;
  1245.             listbox.Items.AddObject(LeftStr(s,300), TObject(ci) );
  1246.         end;
  1247.     end;
  1248. begin
  1249.     // dirty trick to get around Win9X memory limitations
  1250.     // for some components
  1251.     // I'm storing the full string in the object list
  1252.     lbQueue.Items.Clear;
  1253.     lbNontext.Items.Clear;
  1254.     mPreview.Text := '';
  1255.     iPreview.Visible := false;
  1256.     AddItems(ClipQueue, lbQueue);
  1257.     AddItems(OtherQueue, lbNontext);
  1258. end;
  1259.  
  1260. //
  1261. // show the preview when an item is clicke on
  1262. //
  1263. procedure TfrmClipboardManager.lbQueueClick(Sender: TObject);
  1264. var ci : TClipItem;
  1265. begin
  1266.     mPreview.Visible := true;
  1267.     mPreview.Text := LeftStr(ClipQueue.GetItemText(lbQueue.ItemIndex), 1000);
  1268.     if (lbQueue.SelCount = 1) then begin
  1269.         bCopyAs.Visible := true;
  1270.         ci := ClipQueue.GetClipItem(lbQueue.itemindex);
  1271.         bCopyAs.Caption := 'Copy as ' + leftstr(ci.GetFormatName,10);
  1272.         if (ci.GetDataSize <> 0) then begin
  1273.             lblClipSize.Caption := 'Size(bytes): ' + IntToStr(ci.GetDataSize);
  1274.         end else begin
  1275.             lblClipSize.Caption := '';
  1276.         end;
  1277.     end else begin
  1278.         bCopyAs.Visible := false;
  1279.     end;
  1280. end;
  1281.  
  1282. procedure TfrmClipboardManager.bCopyToClipboardClick(Sender: TObject);
  1283. var i : longint;
  1284.     s : string;
  1285.     ci : TClipItem;
  1286. begin
  1287.     if (PageControl1.ActivePageIndex =0) then begin
  1288.         for i := 0 to (lbQueue.Items.count - 1) do begin
  1289.             if lbQueue.Selected[i] then begin
  1290.                 ci := TClipItem(lbQueue.items.Objects[i]);
  1291.                 s := s + ci.GetAsText;
  1292.             end;
  1293.         end;
  1294.  
  1295.         if (s <> '') then begin
  1296.             Paste.SetClipboardOnlyOnce;
  1297.             Paste.SendText(s);
  1298.         end;
  1299.     end else begin
  1300.         i := lbNontext.ItemIndex;
  1301.         if (i <> -1) then begin
  1302.             Paste.SetClipboardOnlyOnce;
  1303.             Paste.SendText('', OtherQueue.GetClipItem(i));
  1304.  
  1305.         end;
  1306.     end;
  1307. end;
  1308.  
  1309. procedure TfrmClipboardManager.bCopyAsClick(Sender: TObject);
  1310. var ci : TClipItem;
  1311. begin
  1312.     if (PageControl1.ActivePageIndex = 0) then begin
  1313.         ci := TClipItem(lbQueue.items.Objects[lbQueue.ItemIndex]);
  1314.         UnitMisc.AppendLog('Copy As ' + ci.GetAsText + ' ' + ci.GetFormatName );
  1315.         Paste.SetClipboardOnlyOnce;
  1316.         Paste.SendText('', ci);
  1317.     end;
  1318. end;
  1319.  
  1320.  
  1321.  
  1322. function TfrmClipboardManager.GetIsOnChain: boolean;
  1323. begin
  1324.     result := self.IsJoinedToChain;
  1325. end;
  1326.  
  1327.  
  1328. //
  1329. // custome draw routines
  1330. //
  1331. procedure TfrmClipboardManager.lbQueueDrawItem(Control: TWinControl;
  1332.   Index: Integer; Rect: TRect; State: TOwnerDrawState);
  1333. var ci : TClipItem;
  1334.     th, h : integer;
  1335.     c : TColor;
  1336.     s : string;
  1337. begin
  1338.     // height of rectangle & height of text on the listbox
  1339.     h := (rect.Bottom - rect.top) + 1;
  1340.     th := lbQueue.Canvas.TextHeight('ALKJDFIOJ');
  1341.  
  1342.  
  1343.     //
  1344.     // draw the icon leaving enough pixels above and below
  1345.     // for the selection outline
  1346.     //
  1347.     s := lbqueue.Items.Strings[index];
  1348.     ci := ClipQueue.GetClipItem(index);
  1349.     if (ci <> nil) then begin
  1350.         if (ci.CData.GetHICON <> 0) then begin
  1351.             DrawIconEX(
  1352.                 lbQueue.Canvas.Handle, rect.Left+2, rect.Top+1,ci.CData.GetHICON,
  1353.                 h-2, h-2,
  1354.                 0,0,DI_NORMAL);
  1355.         end;
  1356.         s := UnitMisc.GetCliptypeSymbol(ci.GetFormat) + ' ' + s;
  1357.     end;
  1358.  
  1359.     // leave a space for the icon
  1360.     // center the text if possible
  1361.     if (h  <=  th) then begin
  1362.         lbqueue.Canvas.TextOut(
  1363.             rect.Left + h + 3, rect.Top, s
  1364.         );
  1365.     end else begin
  1366.         lbqueue.Canvas.TextOut(
  1367.             rect.Left + h + 3, floor((h-th)/2) + rect.Top, s
  1368.         );
  1369.     end;
  1370.  
  1371.  
  1372.     //
  1373.     // Draw/Clear the selection outline
  1374.     //
  1375.     c := lbQueue.Canvas.Brush.color;
  1376.     if (odSelected in state) then begin
  1377.         lbQueue.Canvas.Brush.Color := clHighlight;
  1378.         lbQueue.Canvas.FrameRect(rect);
  1379.     end else begin
  1380.         lbqueue.Canvas.Brush.color := clWindow;
  1381.         lbQueue.Canvas.FrameRect(rect);
  1382.     end;
  1383.     lbQueue.Canvas.Brush.color := c;
  1384.  
  1385. end;
  1386.  
  1387. procedure TfrmClipboardManager.lbQueueMeasureItem(Control: TWinControl;
  1388.   Index: Integer; var Height: Integer);
  1389. begin
  1390.     height := math.max(18, lbQueue.Canvas.TextHeight('ALKJDIOJ')+4);
  1391. end;
  1392.  
  1393.  
  1394.  
  1395. procedure TfrmClipboardManager.lbNontextDrawItem(Control: TWinControl;
  1396.   Index: Integer; Rect: TRect; State: TOwnerDrawState);
  1397. var ci : TClipItem;
  1398.     th, h : integer;
  1399.     c : TColor;
  1400. begin
  1401.     // height of rectangle & height of text on the listbox
  1402.     h := (rect.Bottom - rect.top) + 1;
  1403.     th := lbNontext.Canvas.TextHeight('ALKJDFIOJ');
  1404.  
  1405.     // leave a space for the icon
  1406.     // center the text if possible
  1407.     if (h  <=  th) then begin
  1408.         lbNontext.Canvas.TextOut(
  1409.             rect.Left + h + 3, rect.Top,
  1410.             lbNontext.Items.Strings[index]);
  1411.     end else begin
  1412.         lbNontext.Canvas.TextOut(
  1413.             rect.Left + h + 3, floor((h-th)/2) + rect.Top,
  1414.             lbNontext.Items.Strings[index]);
  1415.     end;
  1416.  
  1417.     //
  1418.     // draw the icon leaving enough pixels above and below
  1419.     // for the selection outline
  1420.     //
  1421.  
  1422.     ci := OtherQueue.GetClipItem(index);
  1423.  
  1424.     if (ci <> nil) then begin
  1425.         if (ci.CData.GetHICON <> 0) then begin
  1426.             lbNontext.Canvas.Brush.Color := clWHite;
  1427.             DrawIconEX(
  1428.                 lbNontext.Canvas.Handle, rect.Left+2, rect.Top+1,ci.CData.GetHICON,
  1429.                 h-2, h-2,
  1430.                 0,0,DI_NORMAL);
  1431.         end;
  1432.     end;
  1433.  
  1434.     //
  1435.     // Draw/Clear the selection outline
  1436.     //
  1437.     c := lbNontext.Canvas.Brush.color;
  1438.     if (odSelected in state) then begin
  1439.         lbNontext.Canvas.Brush.Color := clHighlight;
  1440.         lbNontext.Canvas.FrameRect(rect);
  1441.     end else begin
  1442.         lbNontext.Canvas.Brush.color := clWindow;
  1443.         lbNontext.Canvas.FrameRect(rect);
  1444.     end;
  1445.     lbNontext.Canvas.Brush.color := c;
  1446.  
  1447. end;
  1448.  
  1449.  
  1450. procedure TfrmClipboardManager.PageControl1Change(Sender: TObject);
  1451. begin
  1452.     if (PageControl1.ActivePageIndex = 0) then begin
  1453.         mPreview.Visible := true;
  1454.         iPreview.Visible := false;
  1455.     end else begin
  1456.         bCopyAs.Visible := false;
  1457.         mPreview.Visible := false;
  1458.         iPreview.Visible := true;
  1459.     end;
  1460. end;
  1461.  
  1462. procedure TfrmClipboardManager.lbNontextClick(Sender: TObject);
  1463. var ci : TClipITem;
  1464. begin
  1465.     ci := TCLipITem(lbnontext.items.objects[lbNontext.ItemIndex]);
  1466.     if ci.GetFormat = CF_DIB then begin
  1467.         ipreview.Visible := true;
  1468.         ci.GetDIB(ipreview.Picture);
  1469.     end;
  1470. end;
  1471.  
  1472.  
  1473.  
  1474.  
  1475. procedure TfrmClipboardManager.lbNontextKeyDown(Sender: TObject;
  1476.   var Key: Word; Shift: TShiftState);
  1477. begin
  1478.     if (key = Windows.VK_DELETE) then begin
  1479.         self.btnDelete.Click;
  1480.     end;
  1481. end;
  1482.  
  1483. procedure TfrmClipboardManager.lbQueueKeyDown(Sender: TObject;
  1484.   var Key: Word; Shift: TShiftState);
  1485. begin
  1486.     if (key = Windows.VK_DELETE) then begin
  1487.         self.btnDelete.Click;
  1488.     end;
  1489. end;
  1490.  
  1491. end.
  1492.