1{
2 /***************************************************************************
3                               Clipbrd.pp
4                             -------------------
5                             Component Library Clipboard Controls
6                   Initial Revision  : Sat Feb 26 2000
7
8
9 ***************************************************************************/
10
11 *****************************************************************************
12  This file is part of the Lazarus Component Library (LCL)
13
14  See the file COPYING.modifiedLGPL.txt, included in this distribution,
15  for details about the license.
16 *****************************************************************************
17}
18
19{
20@created(26-Feb-2000)
21@lastmod(12-Nov-2001)
22
23    @abstract(This is the clipboard class for Copy/Paste functions)
24    Introduced by Shane Miller <smiller@lakefield.net>
25    Rewrite done by Hongli Lai <hongli@telekabel.nl>
26    Rewrite done by Mattias Gaertner <gaertner@informatik.uni-koeln.de>
27
28Clipboard unit.
29For Copying and Pasting.  You know what it's for!  Why am I explaining it?  :-)
30
31
32  The clipboard object encapsulates the Windows clipboard and the three
33  standard Gtk selections. For each of the three clipboards/selections there is
34  an object: PrimarySelection, SecondarySelection and Clipboard.
35  There is no difference between the three objects except their type.
36
37  Brief explanation of TClipboard:
38
39  AddFormat:
40    Use these functions to add data to the supported formats.
41  Assign:
42    Add the data to the clipboard with the corresponding FormatID.
43  Clear:
44    Clears the clipboard.
45  FindPictureFormatID
46    Search the first FormatID that is a registered TGraphic.
47  GetComponent
48    Read a component from clipboard
49  GetFormat
50    Read data from clipboard
51  SupportedFormats
52    Fills a TStrings list with the supported mime type.
53  SupportedFormats
54    Returns an array of suupported formats. You must free the memory with
55    FreeMem.
56  GetTextBuf
57    Fetch text from clipboard, if supported.
58  HasFormat
59    Look up if the format is supported. If Format is the TPicture format
60    (CF_PICTURE) all registered graphics formats are tested.
61  HasPictureFormat
62    Returns true if FindPictureFormatID<>0
63  SetComponent
64    Write a component to the clipboard.
65  SetFormat
66    Clears the clipboard and adds the data.
67  SetSupportedFormats
68    Set all supported formats at once. All data will be empty. This procedure
69    is useful if setting the OnRequest event to put the data on the fly.
70    Example: Using the PrimarySelection from synedit.pp
71      procedure TCustomSynEdit.AquirePrimarySelection;
72      var
73        FormatList: TClipboardFormat;
74      begin
75        if (not SelAvail)
76        or (PrimarySelection.OnRequest=@PrimarySelectionRequest) then exit;
77        FormatList:=CF_TEXT;
78        PrimarySelection.SetSupportedFormats(1,@FormatList);
79        PrimarySelection.OnRequest:=@PrimarySelectionRequest;
80      end;
81
82  SetTextBuf
83    Add text to the clipboard
84  AsText
85    Get text from or set text to the clipboard.
86  ClipboardType
87    The type of the clipboard object. For example:
88      PrimarySelection.ClipboardType = ctPrimarySelection
89  FormatCount
90    Number of supported formats
91  Formats
92    You can read the formats with this property one by one. But this will result
93    in many requests, which can be very slow (especially on terminals).
94    Better use "SupportedFormats".
95  OnRequest
96    If the clipboard has the ownership, each time data is requested by the
97    application or another application from the clipboard this event will be
98    called. There is one special case: If the clipboard looses ownership the
99    OnRequest event will be called with FormatID=0.
100    This event will be erased on lost of ownership.
101    If the OnRequest event was already set before, the prior method will be
102    called with FormatID=0 to be notified of the loss.
103
104
105  For mime types see:
106    http://www.iana.org/assignments/media-types
107}
108
109unit Clipbrd;
110
111{$MODE Objfpc}{$H+}
112
113interface
114
115{$ifdef Trace}
116  {$ASSERTIONS ON}
117{$endif}
118
119uses
120  Classes, SysUtils, fasthtmlparser,
121  // LCL
122  LCLType, LCLIntf, LResources, Graphics,
123  // LazUtils
124  FPCAdds, LazUTF8, LazTracer;
125
126{ for delphi compatibility:
127
128  In Delphi there are 4 predefined constants, but the LCL has only dynamic values.
129
130  CF_TEXT = 1;
131  CF_BITMAP = 2;
132  CF_METAFILEPICT = 3;
133
134  CF_OBJECT = 230
135}
136function CF_Text: TClipboardFormat;
137function CF_Bitmap: TClipboardFormat;
138function CF_Picture: TClipboardFormat;
139function CF_MetaFilePict: TClipboardFormat;
140function CF_Object: TClipboardFormat;
141function CF_Component: TClipboardFormat;
142function CF_HTML: TClipboardformat;
143
144type
145  TClipboardData = record
146    FormatID: TClipboardFormat;
147    Stream: TMemoryStream;
148  end;
149
150  { TClipboard }
151
152  TClipboard = Class(TPersistent)
153  private
154    FAllocated: Boolean;    // = has ownership
155    FClipboardType: TClipboardType;
156    FCount: integer;        // # formats of cached clipboard data
157    FData: ^TClipboardData; // cached clipboard data
158    FSupportedFormatsChanged: boolean;
159    FOnRequest: TClipboardRequestEvent;
160    FOpenRefCount: Integer; // reference count for Open and Close (not used yet)
161    procedure AssignGraphic(Source: TGraphic);
162    procedure AssignGraphic(Source: TGraphic; FormatID: TClipboardFormat);
163    procedure AssignPicture(Source: TPicture);
164    function AssignToGraphic(Dest: TGraphic): boolean;
165    function AssignToGraphic(Dest: TGraphic; FormatID: TClipboardFormat): boolean;
166    //procedure AssignToMetafile(Dest: TMetafile);
167    procedure AssignToPicture(Dest: TPicture);
168    function GetAsText: string;
169    function GetFormatCount: Integer;
170    function GetFormats(Index: Integer): TClipboardFormat;
171    function GetOwnerShip: boolean;
172    function IndexOfCachedFormatID(FormatID: TClipboardFormat;
173      CreateIfNotExists: boolean): integer;
174    procedure InternalOnRequest(const RequestedFormatID: TClipboardFormat;
175      AStream: TStream);
176    procedure SetAsText(const Value: string);
177    function SetBuffer(FormatID: TClipboardFormat;
178                       var Buffer; Size: Integer): Boolean;
179    procedure SetOnRequest(AnOnRequest: TClipboardRequestEvent);
180    procedure BeginUpdate;
181    function EndUpdate: Boolean;
182    function IsUpdating: Boolean;
183    function CanReadFromInterface: Boolean;
184    function CanReadFromCache: Boolean;
185    procedure OnDefaultFindClass(Reader: TReader; const AClassName: string;
186                                 var ComponentClass: TComponentClass);
187  public
188    function AddFormat(FormatID: TClipboardFormat; Stream: TStream): Boolean;
189    function AddFormat(FormatID: TClipboardFormat; var Buffer; Size: Integer): Boolean;
190    procedure Assign(Source: TPersistent); override;
191    procedure AssignTo(Dest: TPersistent); override;
192    procedure Clear;
193    procedure Close;
194    constructor Create;
195    constructor Create(AClipboardType: TClipboardType);
196    destructor Destroy; override;
197    function FindPictureFormatID: TClipboardFormat;
198    function FindFormatID(const FormatName: string): TClipboardFormat;
199    //function GetAsHandle(Format: integer): THandle;
200    function GetAsHtml(ExtractFragmentOnly: Boolean): String;
201    function GetComponent(Owner, Parent: TComponent): TComponent;
202    procedure GetComponent(var RootComponent: TComponent;
203                          OnFindComponentClass: TFindComponentClassEvent;
204                          Owner: TComponent = nil;
205                          Parent: TComponent = nil);
206    procedure GetComponentAsText(var RootComponent: TComponent;
207                                 OnFindComponentClass: TFindComponentClassEvent;
208                                 Owner: TComponent = nil;
209                                 Parent: TComponent = nil);
210    function GetFormat(FormatID: TClipboardFormat; Stream: TStream): Boolean;
211    procedure SupportedFormats(List: TStrings);
212    procedure SupportedFormats(var AFormatCount: integer;
213                               var FormatList: PClipboardFormat);
214    function GetTextBuf(Buffer: PChar; BufSize: Integer): Integer;
215    function HasFormat(FormatID: TClipboardFormat): Boolean;
216    function HasFormatName(const FormatName: string): Boolean;
217    function HasPictureFormat: boolean;
218    procedure Open;
219    //procedure SetAsHandle(Format: integer; Value: THandle);
220    procedure SetAsHtml(Html: String);
221    procedure SetAsHtml(Html: String; const PlainText: String);
222    function SetComponent(Component: TComponent): Boolean;
223    function SetComponentAsText(Component: TComponent): Boolean;
224    function SetFormat(FormatID: TClipboardFormat; Stream: TStream): Boolean;
225    function SetSupportedFormats(AFormatCount: integer;
226                                  FormatList: PClipboardFormat): Boolean;
227    procedure SetTextBuf(Buffer: PChar);
228    property AsText: string read GetAsText write SetAsText;
229    property ClipboardType: TClipboardType read FClipboardType;
230    property FormatCount: Integer read GetFormatCount;
231    property Formats[Index: Integer]: TClipboardFormat read GetFormats;
232    property OnRequest: TClipboardRequestEvent read FOnRequest write SetOnRequest;
233  end;
234
235
236function Clipboard: TClipboard;
237function SetClipboard(NewClipboard: TClipboard): TClipboard;
238function PrimarySelection: TClipboard;
239function SecondarySelection: TClipboard;
240function Clipboard(ClipboardType: TClipboardType): TClipboard;
241function SetClipboard(ClipboardType: TClipboardType;
242  NewClipboard: TClipboard): TClipboard;
243procedure FreeAllClipboards;
244
245function RegisterClipboardFormat(const Format: string): TClipboardFormat;
246
247
248implementation
249
250var
251  FClipboards: array[TClipboardType] of TClipboard;
252
253{$I clipbrd.inc}
254
255function RegisterClipboardFormat(const Format: string): TClipboardFormat;
256begin
257  Result:=ClipboardRegisterFormat(Format);
258end;
259
260function Clipboard: TClipboard;
261begin
262  Result:=Clipboard(ctClipboard);
263end;
264
265function SetClipboard(NewClipboard: TClipboard): TClipboard;
266begin
267  Result:=SetClipboard(ctClipboard,NewClipboard);
268end;
269
270function PrimarySelection: TClipboard;
271begin
272  Result:=Clipboard(ctPrimarySelection);
273end;
274
275function SecondarySelection: TClipboard;
276begin
277  Result:=Clipboard(ctSecondarySelection);
278end;
279
280function Clipboard(ClipboardType: TClipboardType): TClipboard;
281begin
282  if not Assigned(FClipboards[ClipboardType]) then
283     FClipboards[ClipboardType] := TClipboard.Create(ClipboardType);
284  Result := FClipboards[ClipboardType];
285end;
286
287function SetClipboard(ClipboardType: TClipboardType;
288  NewClipboard: TClipboard): TClipboard;
289begin
290  if Assigned(FClipboards[ClipboardType]) then
291  begin
292     FClipboards[ClipboardType].Free;
293     FClipboards[ClipboardType] := nil;
294  end;
295  FClipboards[ClipboardType] := NewClipboard;
296  Result := FClipboards[ClipboardType];
297end;
298
299function CF_Text: TClipboardFormat;
300begin
301  Result:=PredefinedClipboardFormat(pcfText);
302end;
303
304function CF_Bitmap: TClipboardFormat;
305begin
306  Result:=PredefinedClipboardFormat(pcfBitmap);
307end;
308
309function CF_Picture: TClipboardFormat;
310begin
311  Result:=PredefinedClipboardFormat(pcfPicture);
312end;
313
314function CF_MetaFilePict: TClipboardFormat;
315begin
316  Result:=PredefinedClipboardFormat(pcfMetaFilePict);
317end;
318
319function CF_Object: TClipboardFormat;
320begin
321  Result:=PredefinedClipboardFormat(pcfObject);
322end;
323
324function CF_Component: TClipboardFormat;
325begin
326  Result:=PredefinedClipboardFormat(pcfComponent);
327end;
328
329procedure FreeAllClipboards;
330var AClipboardType: TClipboardType;
331begin
332  for AClipboardType:=Low(TClipboardType) to High(TClipboardType) do
333    FreeAndNil(FClipboards[AClipboardType]);
334end;
335
336procedure LoadGraphicFromClipboardFormat(Dest: TGraphic;
337  ClipboardType: TClipboardType; FormatID: TClipboardFormat);
338begin
339  Clipboard(ClipboardType).AssignToGraphic(Dest,FormatID);
340end;
341
342procedure SaveGraphicToClipboardFormat(Src: TGraphic;
343  ClipboardType: TClipboardType; FormatID: TClipboardFormat);
344begin
345  Clipboard(ClipboardType).AssignGraphic(Src,FormatID);
346end;
347
348//-----------------------------------------------------------------------------
349
350procedure InternalInit;
351var
352  AClipboardType: TClipboardType;
353begin
354  OnLoadGraphicFromClipboardFormat:=@LoadGraphicFromClipboardFormat;
355  OnSaveGraphicToClipboardFormat:=@SaveGraphicToClipboardFormat;
356  OnLoadSaveClipBrdGraphicValid:=true;
357
358  for AClipboardType:=Low(TClipboardType) to High(TClipboardType) do
359    FClipboards[AClipboardType]:=nil;
360end;
361
362procedure InternalFinal;
363begin
364  OnLoadSaveClipBrdGraphicValid:=false;
365  FreeAllClipboards;
366end;
367
368initialization
369  InternalInit;
370
371finalization
372  InternalFinal;
373
374end.
375