home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d6 / RX275D6.ZIP / Units / clipmon.pas < prev    next >
Pascal/Delphi Source File  |  1999-10-12  |  4KB  |  173 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {         Delphi VCL Extensions (RX)                    }
  4. {                                                       }
  5. {         Copyright (c) 1996 AO ROSNO                   }
  6. {         Copyright (c) 1998 Master-Bank                }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit ClipMon;
  11.  
  12. interface
  13.  
  14. {$I RX.INC}
  15.  
  16. uses Messages, {$IFDEF WIN32} Windows, {$ELSE} WinTypes, WinProcs, {$ENDIF}
  17.   SysUtils, Classes;
  18.  
  19. type
  20.   TClipboardMonitor = class(TComponent)
  21.   private
  22.     FWindowHandle: HWnd;
  23.     FNextWindow: HWnd;
  24.     FEnabled: Boolean;
  25.     FOnChange: TNotifyEvent;
  26.     procedure ForwardMessage(var Msg: TMessage);
  27.     procedure SetEnabled(Value: Boolean);
  28.     procedure WndProc(var AMsg: TMessage);
  29.     procedure ClipboardChanged;
  30.   protected
  31.     procedure Change; dynamic;
  32.   public
  33.     constructor Create(AOwner: TComponent); override;
  34.     destructor Destroy; override;
  35.   published
  36.     property Enabled: Boolean read FEnabled write SetEnabled default True;
  37.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  38.   end;
  39.  
  40. procedure SaveClipboardToStream(Format: Word; Stream: TStream);
  41. procedure LoadClipboardFromStream(Format: Word; Stream: TStream; Size: Longint);
  42.  
  43. implementation
  44.  
  45. uses Forms, Clipbrd;
  46.  
  47. { Stream routines }
  48.  
  49. procedure SaveClipboardToStream(Format: Word; Stream: TStream);
  50. var
  51.   Buffer: Pointer;
  52.   Data: THandle;
  53. begin
  54.   Clipboard.Open;
  55.   try
  56.     Data := GetClipboardData(Format);
  57.     if Data = 0 then Exit;
  58.     Buffer := GlobalLock(Data);
  59.     try
  60.       Stream.Write(Buffer^, GlobalSize(Data));
  61.     finally
  62.       GlobalUnlock(Data);
  63.     end;
  64.   finally
  65.     Clipboard.Close;
  66.   end;
  67. end;
  68.  
  69. procedure LoadClipboardFromStream(Format: Word; Stream: TStream; Size: Longint);
  70. var
  71.   Len: Longint;
  72.   Buffer: Pointer;
  73.   Data: THandle;
  74. begin
  75.   Clipboard.Open;
  76.   try
  77.     Len := Stream.Size - Stream.Position;
  78.     if Len > Size then Len := Size;
  79.     Data := GlobalAlloc(HeapAllocFlags, Len);
  80.     try
  81.       if Data <> 0 then begin
  82.         Buffer := GlobalLock(Data);
  83.         try
  84.           Stream.Read(Buffer^, Len);
  85.           SetClipboardData(Format, Data);
  86.         finally
  87.           GlobalUnlock(Data);
  88.         end;
  89.       end;
  90.     except
  91.       GlobalFree(Data);
  92.       raise;
  93.     end;
  94.   finally
  95.     Clipboard.Close;
  96.   end;
  97. end;
  98.  
  99. { TClipboardMonitor }
  100.  
  101. constructor TClipboardMonitor.Create(AOwner: TComponent);
  102. begin
  103.   inherited Create(AOwner);
  104.   FWindowHandle := AllocateHWnd(WndProc);
  105.   SetEnabled(True);
  106. end;
  107.  
  108. destructor TClipboardMonitor.Destroy;
  109. begin
  110.   FOnChange := nil;
  111.   SetEnabled(False);
  112.   DeallocateHWnd(FWindowHandle);
  113.   inherited Destroy;
  114. end;
  115.  
  116. procedure TClipboardMonitor.ForwardMessage(var Msg: TMessage);
  117. begin
  118.   if FNextWindow <> 0 then
  119.     with Msg do SendMessage(FNextWindow, Msg, WParam, LParam);
  120. end;
  121.  
  122. procedure TClipboardMonitor.WndProc(var AMsg: TMessage);
  123. begin
  124.   with AMsg do begin
  125.     Result := 0;
  126.     case Msg of
  127.       WM_DESTROYCLIPBOARD:
  128.         ClipboardChanged;
  129.       WM_CHANGECBCHAIN:
  130.         if HWnd(WParam) = FNextWindow then FNextWindow := HWnd(LParam)
  131.         else ForwardMessage(AMsg);
  132.       WM_DRAWCLIPBOARD:
  133.         begin
  134.           ForwardMessage(AMsg);
  135.           ClipboardChanged;
  136.         end;
  137.       WM_DESTROY:
  138.         SetEnabled(False);
  139.       else Result := DefWindowProc(FWindowHandle, Msg, WParam, LParam);
  140.     end;
  141.   end;
  142. end;
  143.  
  144. procedure TClipboardMonitor.SetEnabled(Value: Boolean);
  145. begin
  146.   if FEnabled <> Value then begin
  147.     if Value then begin
  148.       FNextWindow := SetClipboardViewer(FWindowHandle);
  149.       FEnabled := True;
  150.     end
  151.     else begin
  152.       ChangeClipboardChain(FWindowHandle, FNextWindow);
  153.       FEnabled := False;
  154.       FNextWindow := 0;
  155.     end;
  156.   end;
  157. end;
  158.  
  159. procedure TClipboardMonitor.ClipboardChanged;
  160. begin
  161.   try
  162.     Change;
  163.   except
  164.     Application.HandleException(Self);
  165.   end;
  166. end;
  167.  
  168. procedure TClipboardMonitor.Change;
  169. begin
  170.   if Assigned(FOnChange) then FOnChange(Self);
  171. end;
  172.  
  173. end.