home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Softwarová Záchrana 3
/
Softwarova-zachrana-3.bin
/
ArsClip
/
source.zip
/
UnitTooltipPopup.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
2003-06-06
|
6KB
|
234 lines
unit UnitTooltipPopup;
{
Purpose:
Show a single clipboard item using a Tooltip window - aka Tooltip Popup
Notes:
The ClearToolip must be the only way used to clear the tooltip,
this ShowTooltip threads from infinitely looping waiting for a click,
or another "Show" call
Updates
SHIFT & CTRL to paste & Dissmiss
Full header Tooltip option
}
interface
uses Windows, CommCtrl, Messages, Controls, Classes, Graphics { for colors}
, UnitFrmDummyUnicodeTooltip, UnitTWideChar;
Type TTooltipPopup = class(TObject)
private
ClipIndex : integer;
StillShowing : boolean; // True until tooltip dismissed
HandlingClick : boolean; // poor man's semaphore
Tooltip : TTooltipWindow;
procedure HandleClick;
procedure ShowTooltip(x, y : integer; Next : boolean);
procedure ClearTooltip;
procedure PlaceCurrentOnClipboard;
protected
// procedure WMNCHitTest(VAR Msg: TWMNcHitTest); message WM_NCHITTEST;
public
constructor Create;
procedure ShowTooltipNext( x,y : integer);
procedure ShowTooltipPrev( x,y : integer);
end;
implementation
uses Forms, UnitKeyboardQuery, Math, Dialogs, SysUtils,
UnitClipQueue, UnitPaste, UnitFrmConfig;
constructor TTooltipPopup.Create;
begin
inherited;
Tooltip := TTooltipWindow.Create;
{self.ClipIndex := 0;
self.Font.Name := 'Verdana';
self.Color := Graphics.clInfoBk;}
end;
//
// The tooltip index isn't altered until the tooltip is shown again
// while it's already visible
//
procedure TTooltipPopup.ShowTooltipNext(x,y : integer);
begin
if (self.StillShowing) then begin
self.ClearTooltip;
inc(ClipIndex);
if (Cardinal(ClipIndex) >= ClipQueue.GetQueueCount) then ClipIndex := ClipQueue.GetQueueCount - 1;
end;
self.ShowTooltip(x,y, true);
end;
procedure TTooltipPopup.ShowTooltipPrev(x,y : integer);
begin
if (self.StillShowing) then begin
self.ClearTooltip;
dec(ClipIndex);
if (ClipIndex < 0 ) then ClipIndex := 0;
end;
self.ShowTooltip(x,y,false);
end;
procedure TTooltipPopup.ShowTooltip(x, y: integer; Next: boolean);
var s : string;
ShiftPressed,
CtrlPressed,
LeftPressed,
RightPressed : boolean;
ci : TClipItem;
wc : TWideChar;
function GetHeader : string;
var sid : string;
begin
// Generate header (simple of full
//
sid := '';
if (cardinal(ClipIndex) = ClipQueue.GetQueueCount - 1) then begin
sid := '(last)';
end;
if (FrmConfig.cbFullHeader.checked) then begin
result := '['+IntToSTr(ClipIndex+1)+':'+sid+' Click or Shift Pastes - RightClick or Ctrl Closes ]'
+ #13#10;
end else begin
result := IntToStr(ClipIndex+1)+':'+sid+' ';
end;
end;
var Clicked : boolean;
begin
if (ClipQueue.GetQueueCount = 0) then EXIT;
self.StillShowing := true; {cleared by ClearTooltip}
//
// Show the text or unicode version of clip
//
s := Getheader;
ci := ClipQueue.GetClipItem(ClipIndex);
if (ci.GetFormat = CF_UNICODETEXT) then begin
wc := TWideChar.Create;
wc.Append(s);
wc.Append(ci.GetHandle, ci.GetDataSize);
Tooltip.ShowTooltip(wc, Point(x,y));
end else begin
Tooltip.ShowTooltip(s + ci.GetAsText, Point(x,y));
end;
if (FrmConfig.cbCopyVisibleItem.Checked) then begin
self.PlaceCurrentOnClipboard;
end;
// show
// - wait for ESC to be pressed, or
// - the user clicked this tooltip (handled via a Message)
// - the user hit the hotkey again
// Git rid of the window
ShiftPressed := false;
CtrlPressed := false;
LeftPressed := false;
//RightPressed := false;
Clicked := false;
KeyboardQuery.WaitUntilRelease(VK_SHIFT);
KeyboardQuery.WaitUntilRelease(VK_CONTROL);
while not (
ShiftPressed or
CtrlPressed or
KeyboardQuery.IsPressed(VK_ESCAPE) or
Clicked or
(not self.StillShowing)
) do begin
ShiftPressed := KeyboardQuery.IsPressed(VK_SHIFT);
CtrlPressed := KeyboardQuery.IsPressed(VK_CONTROL);
LeftPRessed := KeyboardQuery.IsClicked(leftButton);
RightPRessed := KeyboardQuery.IsClicked(rightButton);
Clicked := (LeftPressed or RightPressed)
and Tooltip.IsHit(Mouse.CursorPos);
Application.ProcessMessages;
end;
KeyboardQuery.WaitUntilRelease(VK_SHIFT);
KeyboardQuery.WaitUntilRelease(VK_CONTROL);
KeyboardQuery.WaitUntilRelease(LeftButton);
KeyboardQuery.WaitUntilRelease(RightButton);
//
// In case SHIFT is part of the hotkey to show this window, wait for
// it to be released before monitoring user input - then wait for it
// to be released if it was user input
//
if (LeftPressed) or (ShiftPressed) then begin
self.HandleClick;
end else begin
self.ClearTooltip;
end;
end;
procedure TTooltipPopup.HandleClick;
var ci : TClipItem;
begin
//
// Item was normally clicked
//
if (HandlingClick) then exit;
self.HandlingClick := true;
self.ClearTooltip;
//
// Always paste as unicode, if available
//
ci := ClipQueue.GetClipItem(ClipIndex);
if (ci <> nil) and (ci.GetFormat = CF_UNICODETEXT) then begin
Paste.SendText('', ci);
end else begin
Paste.SendText(ClipQueue.GetItemText(ClipIndex));
end;
self.HandlingClick := false;
end;
procedure TTooltipPopup.ClearTooltip;
begin
Tooltip.CloseTooltip;
self.StillShowing := false;
end;
procedure TTooltipPopup.PlaceCurrentOnClipboard;
var ci : TClipItem;
begin
ci := ClipQueue.GetClipItem(ClipIndex);
Paste.SetClipboardOnlyOnce;
if (ci <> nil) and (ci.GetFormat = CF_UNICODETEXT) then begin
Paste.SendText('', ci);
end else begin
Paste.SendText(ClipQueue.GetItemText(ClipIndex));
end;
end;
end.