home *** CD-ROM | disk | FTP | other *** search
/ Softwarová Záchrana 3 / Softwarova-zachrana-3.bin / ArsClip / source.zip / UnitTooltipPopup.pas < prev    next >
Pascal/Delphi Source File  |  2003-06-06  |  6KB  |  234 lines
  1. unit UnitTooltipPopup;
  2. {
  3.     Purpose:
  4.         Show a single clipboard item using a Tooltip window - aka Tooltip Popup
  5.  
  6.     Notes:
  7.         The ClearToolip must be the only way used to clear the tooltip,
  8.         this ShowTooltip threads from infinitely looping waiting for a click,
  9.         or another "Show" call
  10.  
  11.     Updates
  12.         SHIFT & CTRL to paste & Dissmiss
  13.         Full header Tooltip option
  14.  
  15. }
  16.  
  17.  
  18. interface
  19.  
  20. uses Windows, CommCtrl, Messages, Controls, Classes, Graphics { for colors}
  21.     , UnitFrmDummyUnicodeTooltip, UnitTWideChar;
  22.  
  23. Type TTooltipPopup = class(TObject)
  24.     private
  25.         ClipIndex : integer;
  26.  
  27.         StillShowing : boolean;   // True until tooltip dismissed
  28.         HandlingClick : boolean;  // poor man's semaphore
  29.  
  30.         Tooltip : TTooltipWindow;
  31.  
  32.         procedure HandleClick;
  33.         procedure ShowTooltip(x, y : integer; Next : boolean);
  34.         procedure ClearTooltip;
  35.         procedure PlaceCurrentOnClipboard;
  36.     protected
  37.        // procedure WMNCHitTest(VAR Msg: TWMNcHitTest); message WM_NCHITTEST;
  38.     public
  39.         constructor Create;
  40.  
  41.         procedure ShowTooltipNext( x,y : integer);
  42.         procedure ShowTooltipPrev( x,y : integer);
  43.  
  44. end;
  45.  
  46. implementation
  47.  
  48.  
  49. uses Forms, UnitKeyboardQuery, Math, Dialogs, SysUtils,
  50.   UnitClipQueue, UnitPaste, UnitFrmConfig;
  51.  
  52. constructor TTooltipPopup.Create;
  53. begin
  54.     inherited;
  55.     Tooltip := TTooltipWindow.Create;
  56.  
  57.     {self.ClipIndex := 0;
  58.     self.Font.Name := 'Verdana';
  59.     self.Color := Graphics.clInfoBk;}
  60. end;
  61.  
  62. //
  63. // The tooltip index isn't altered until the tooltip is shown again
  64. // while it's already visible
  65. //
  66. procedure TTooltipPopup.ShowTooltipNext(x,y : integer);
  67. begin
  68.     if (self.StillShowing) then begin
  69.         self.ClearTooltip;
  70.         inc(ClipIndex);
  71.         if (Cardinal(ClipIndex) >= ClipQueue.GetQueueCount) then ClipIndex := ClipQueue.GetQueueCount - 1;
  72.     end;
  73.     self.ShowTooltip(x,y, true);
  74. end;
  75. procedure TTooltipPopup.ShowTooltipPrev(x,y : integer);
  76. begin
  77.     if (self.StillShowing) then begin
  78.         self.ClearTooltip;
  79.         dec(ClipIndex);
  80.         if (ClipIndex < 0 ) then ClipIndex := 0;
  81.     end;
  82.     self.ShowTooltip(x,y,false);
  83. end;
  84. procedure TTooltipPopup.ShowTooltip(x, y: integer; Next: boolean);
  85. var s : string;
  86.  
  87.     ShiftPressed,
  88.     CtrlPressed,
  89.     LeftPressed,
  90.     RightPressed  : boolean;
  91.  
  92.     ci : TClipItem;
  93.     wc : TWideChar;
  94.  
  95.     function GetHeader : string;
  96.     var sid : string;
  97.     begin
  98.         // Generate header (simple of full
  99.         //
  100.         sid := '';
  101.         if (cardinal(ClipIndex) = ClipQueue.GetQueueCount - 1) then begin
  102.             sid := '(last)';
  103.         end;
  104.         if (FrmConfig.cbFullHeader.checked) then begin
  105.             result := '['+IntToSTr(ClipIndex+1)+':'+sid+' Click or Shift Pastes  -  RightClick or Ctrl Closes ]'
  106.             + #13#10;
  107.         end else begin
  108.             result := IntToStr(ClipIndex+1)+':'+sid+' ';
  109.         end;
  110.     end;
  111. var Clicked : boolean;
  112. begin
  113.     if (ClipQueue.GetQueueCount = 0) then EXIT;
  114.     self.StillShowing := true; {cleared by ClearTooltip}
  115.  
  116.  
  117.  
  118.     //
  119.     // Show the text or unicode version of clip
  120.     //
  121.     s := Getheader;
  122.     ci := ClipQueue.GetClipItem(ClipIndex);
  123.     if (ci.GetFormat = CF_UNICODETEXT) then begin
  124.         wc := TWideChar.Create;
  125.         wc.Append(s);
  126.         wc.Append(ci.GetHandle, ci.GetDataSize);
  127.         Tooltip.ShowTooltip(wc, Point(x,y));
  128.     end else begin
  129.         Tooltip.ShowTooltip(s + ci.GetAsText, Point(x,y));
  130.     end;
  131.  
  132.  
  133.     if (FrmConfig.cbCopyVisibleItem.Checked) then begin
  134.         self.PlaceCurrentOnClipboard;
  135.     end;
  136.  
  137.     // show
  138.     // - wait for ESC to be pressed, or
  139.     // - the user clicked this tooltip (handled via a Message)
  140.     // - the user hit the hotkey again
  141.     // Git rid of the window
  142.  
  143.     ShiftPressed := false;
  144.     CtrlPressed := false;
  145.     LeftPressed := false;
  146.     //RightPressed := false;
  147.     Clicked := false;
  148.  
  149.     KeyboardQuery.WaitUntilRelease(VK_SHIFT);
  150.     KeyboardQuery.WaitUntilRelease(VK_CONTROL);
  151.  
  152.     while not (
  153.         ShiftPressed or
  154.         CtrlPressed or
  155.         KeyboardQuery.IsPressed(VK_ESCAPE) or
  156.         Clicked or
  157.         (not self.StillShowing)
  158.     ) do begin
  159.  
  160.         ShiftPressed := KeyboardQuery.IsPressed(VK_SHIFT);
  161.         CtrlPressed := KeyboardQuery.IsPressed(VK_CONTROL);
  162.         LeftPRessed := KeyboardQuery.IsClicked(leftButton);
  163.         RightPRessed := KeyboardQuery.IsClicked(rightButton);
  164.  
  165.         Clicked := (LeftPressed or RightPressed)
  166.             and Tooltip.IsHit(Mouse.CursorPos);
  167.  
  168.         Application.ProcessMessages;
  169.     end;
  170.  
  171.     KeyboardQuery.WaitUntilRelease(VK_SHIFT);
  172.     KeyboardQuery.WaitUntilRelease(VK_CONTROL);
  173.     KeyboardQuery.WaitUntilRelease(LeftButton);
  174.     KeyboardQuery.WaitUntilRelease(RightButton);
  175.  
  176.     //
  177.     // In case SHIFT is part of the hotkey to show this window, wait for
  178.     // it to be released before monitoring user input - then wait for it
  179.     // to be released if it was user input
  180.     //
  181.  
  182.  
  183.     if (LeftPressed) or (ShiftPressed) then begin
  184.         self.HandleClick;
  185.     end else begin
  186.         self.ClearTooltip;
  187.     end;
  188. end;
  189.  
  190.  
  191. procedure TTooltipPopup.HandleClick;
  192. var ci : TClipItem;
  193. begin
  194.     //
  195.     // Item was normally clicked
  196.     //
  197.     if (HandlingClick) then exit;
  198.     self.HandlingClick := true;
  199.     self.ClearTooltip;
  200.     //
  201.     // Always paste as unicode, if available
  202.     //
  203.     ci := ClipQueue.GetClipItem(ClipIndex);
  204.     if (ci <> nil) and (ci.GetFormat = CF_UNICODETEXT) then begin
  205.         Paste.SendText('', ci);
  206.     end else begin
  207.         Paste.SendText(ClipQueue.GetItemText(ClipIndex));
  208.     end;
  209.  
  210.     self.HandlingClick := false;
  211. end;
  212.  
  213.  
  214.  
  215. procedure TTooltipPopup.ClearTooltip;
  216. begin
  217.     Tooltip.CloseTooltip;
  218.     self.StillShowing := false;
  219. end;
  220.  
  221. procedure TTooltipPopup.PlaceCurrentOnClipboard;
  222. var ci : TClipItem;
  223. begin
  224.     ci := ClipQueue.GetClipItem(ClipIndex);
  225.     Paste.SetClipboardOnlyOnce;
  226.     if (ci <> nil) and (ci.GetFormat = CF_UNICODETEXT) then begin
  227.         Paste.SendText('', ci);
  228.     end else begin
  229.         Paste.SendText(ClipQueue.GetItemText(ClipIndex));
  230.     end;
  231. end;
  232.  
  233. end.
  234.