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