0,0 → 1,442 |
unit DragDropText; |
|
// ----------------------------------------------------------------------------- |
// Project: Drag and Drop Component Suite. |
// Module: DragDropText |
// Description: Implements Dragging and Dropping of different text formats. |
// Version: 4.0 |
// Date: 18-MAY-2001 |
// Target: Win32, Delphi 5-6 |
// Authors: Anders Melander, anders@melander.dk, http://www.melander.dk |
// Copyright © 1997-2001 Angus Johnson & Anders Melander |
// ----------------------------------------------------------------------------- |
interface |
|
uses |
DragDrop, |
DropTarget, |
DropSource, |
DragDropFormats, |
ActiveX, |
Windows, |
Classes; |
|
type |
//////////////////////////////////////////////////////////////////////////////// |
// |
// TRichTextClipboardFormat |
// |
//////////////////////////////////////////////////////////////////////////////// |
TRichTextClipboardFormat = class(TCustomTextClipboardFormat) |
public |
function GetClipboardFormat: TClipFormat; override; |
function HasData: boolean; override; |
function Assign(Source: TCustomDataFormat): boolean; override; |
function AssignTo(Dest: TCustomDataFormat): boolean; override; |
property Text; |
end; |
|
//////////////////////////////////////////////////////////////////////////////// |
// |
// TUnicodeTextClipboardFormat |
// |
//////////////////////////////////////////////////////////////////////////////// |
TUnicodeTextClipboardFormat = class(TCustomWideTextClipboardFormat) |
public |
function GetClipboardFormat: TClipFormat; override; |
function Assign(Source: TCustomDataFormat): boolean; override; |
function AssignTo(Dest: TCustomDataFormat): boolean; override; |
property Text; |
end; |
|
//////////////////////////////////////////////////////////////////////////////// |
// |
// TOEMTextClipboardFormat |
// |
//////////////////////////////////////////////////////////////////////////////// |
TOEMTextClipboardFormat = class(TCustomTextClipboardFormat) |
public |
function GetClipboardFormat: TClipFormat; override; |
function Assign(Source: TCustomDataFormat): boolean; override; |
function AssignTo(Dest: TCustomDataFormat): boolean; override; |
property Text; |
end; |
|
//////////////////////////////////////////////////////////////////////////////// |
// |
// TCSVClipboardFormat |
// |
//////////////////////////////////////////////////////////////////////////////// |
TCSVClipboardFormat = class(TCustomStringListClipboardFormat) |
public |
function GetClipboardFormat: TClipFormat; override; |
function Assign(Source: TCustomDataFormat): boolean; override; |
function AssignTo(Dest: TCustomDataFormat): boolean; override; |
property Lines; |
end; |
|
//////////////////////////////////////////////////////////////////////////////// |
// |
// TLocaleClipboardFormat |
// |
//////////////////////////////////////////////////////////////////////////////// |
TLocaleClipboardFormat = class(TCustomDWORDClipboardFormat) |
public |
function GetClipboardFormat: TClipFormat; override; |
function HasData: boolean; override; |
function Assign(Source: TCustomDataFormat): boolean; override; |
function AssignTo(Dest: TCustomDataFormat): boolean; override; |
property Locale: DWORD read GetValueDWORD; |
end; |
|
//////////////////////////////////////////////////////////////////////////////// |
// |
// TDropTextTarget |
// |
//////////////////////////////////////////////////////////////////////////////// |
TDropTextTarget = class(TCustomDropMultiTarget) |
private |
FTextFormat : TTextDataFormat; |
protected |
function GetText: string; |
public |
constructor Create(AOwner: TComponent); override; |
destructor Destroy; override; |
property Text: string read GetText; |
end; |
|
//////////////////////////////////////////////////////////////////////////////// |
// |
// TDropTextSource |
// |
//////////////////////////////////////////////////////////////////////////////// |
TDropTextSource = class(TCustomDropMultiSource) |
private |
FTextFormat : TTextDataFormat; |
protected |
function GetText: string; |
procedure SetText(const Value: string); |
public |
constructor Create(aOwner: TComponent); override; |
destructor Destroy; override; |
published |
property Text: string read GetText write SetText; |
end; |
|
|
//////////////////////////////////////////////////////////////////////////////// |
// |
// Component registration |
// |
//////////////////////////////////////////////////////////////////////////////// |
procedure Register; |
|
|
//////////////////////////////////////////////////////////////////////////////// |
// |
// Misc. |
// |
//////////////////////////////////////////////////////////////////////////////// |
function IsRTF(const s: string): boolean; |
function MakeRTF(const s: string): string; |
|
//////////////////////////////////////////////////////////////////////////////// |
//////////////////////////////////////////////////////////////////////////////// |
// |
// IMPLEMENTATION |
// |
//////////////////////////////////////////////////////////////////////////////// |
//////////////////////////////////////////////////////////////////////////////// |
implementation |
|
uses |
SysUtils; |
|
//////////////////////////////////////////////////////////////////////////////// |
// |
// Component registration |
// |
//////////////////////////////////////////////////////////////////////////////// |
procedure Register; |
begin |
RegisterComponents(DragDropComponentPalettePage, [TDropTextTarget, |
TDropTextSource]); |
end; |
|
//////////////////////////////////////////////////////////////////////////////// |
// |
// Utilities |
// |
//////////////////////////////////////////////////////////////////////////////// |
function IsRTF(const s: string): boolean; |
begin |
// This probably isn't a valid test, but it will have to do until I have |
// time to research the RTF specifications. |
{ TODO -oanme -cImprovement : Need a solid test for RTF format. } |
Result := (AnsiStrLIComp(PChar(s), '{\rtf', 5) = 0); |
end; |
|
{ TODO -oanme -cImprovement : Needs RTF to text conversion. Maybe ITextDocument can be used. } |
function MakeRTF(const s: string): string; |
begin |
{ TODO -oanme -cImprovement : Needs to escape \ in text to RTF conversion. } |
{ TODO -oanme -cImprovement : Needs better text to RTF conversion. } |
if (not IsRTF(s)) then |
Result := '{\rtf1\ansi ' + s + '}' |
else |
Result := s; |
end; |
|
|
//////////////////////////////////////////////////////////////////////////////// |
// |
// TRichTextClipboardFormat |
// |
//////////////////////////////////////////////////////////////////////////////// |
var |
CF_RTF: TClipFormat = 0; |
|
function TRichTextClipboardFormat.GetClipboardFormat: TClipFormat; |
begin |
// Note: The string 'Rich Text Format', is also defined in the RichEdit |
// unit as CF_RTF |
if (CF_RTF = 0) then |
CF_RTF := RegisterClipboardFormat('Rich Text Format'); // *** DO NOT LOCALIZE *** |
Result := CF_RTF; |
end; |
|
function TRichTextClipboardFormat.HasData: boolean; |
begin |
Result := inherited HasData and IsRTF(Text); |
end; |
|
function TRichTextClipboardFormat.Assign(Source: TCustomDataFormat): boolean; |
begin |
if (Source is TTextDataFormat) then |
begin |
Text := MakeRTF(TTextDataFormat(Source).Text); |
Result := True; |
end else |
Result := inherited Assign(Source); |
end; |
|
function TRichTextClipboardFormat.AssignTo(Dest: TCustomDataFormat): boolean; |
begin |
if (Dest is TTextDataFormat) then |
begin |
TTextDataFormat(Dest).Text := Text; |
Result := True; |
end else |
Result := inherited AssignTo(Dest); |
end; |
|
|
//////////////////////////////////////////////////////////////////////////////// |
// |
// TUnicodeTextClipboardFormat |
// |
//////////////////////////////////////////////////////////////////////////////// |
function TUnicodeTextClipboardFormat.GetClipboardFormat: TClipFormat; |
begin |
Result := CF_UNICODETEXT; |
end; |
|
function TUnicodeTextClipboardFormat.Assign(Source: TCustomDataFormat): boolean; |
begin |
if (Source is TTextDataFormat) then |
begin |
Text := TTextDataFormat(Source).Text; |
Result := True; |
end else |
Result := inherited Assign(Source); |
end; |
|
function TUnicodeTextClipboardFormat.AssignTo(Dest: TCustomDataFormat): boolean; |
begin |
if (Dest is TTextDataFormat) then |
begin |
TTextDataFormat(Dest).Text := Text; |
Result := True; |
end else |
Result := inherited AssignTo(Dest); |
end; |
|
|
//////////////////////////////////////////////////////////////////////////////// |
// |
// TOEMTextClipboardFormat |
// |
//////////////////////////////////////////////////////////////////////////////// |
function TOEMTextClipboardFormat.GetClipboardFormat: TClipFormat; |
begin |
Result := CF_OEMTEXT; |
end; |
|
function TOEMTextClipboardFormat.Assign(Source: TCustomDataFormat): boolean; |
var |
OEMText : string; |
begin |
if (Source is TTextDataFormat) then |
begin |
// First convert ANSI string to OEM string... |
SetLength(OEMText, Length(TTextDataFormat(Source).Text)); |
CharToOemBuff(PChar(TTextDataFormat(Source).Text), PChar(OEMText), |
Length(TTextDataFormat(Source).Text)); |
// ...then assign OEM string |
Text := OEMText; |
Result := True; |
end else |
Result := inherited Assign(Source); |
end; |
|
function TOEMTextClipboardFormat.AssignTo(Dest: TCustomDataFormat): boolean; |
var |
AnsiText : string; |
begin |
if (Dest is TTextDataFormat) then |
begin |
// First convert OEM string to ANSI string... |
SetLength(AnsiText, Length(Text)); |
OemToCharBuff(PChar(Text), PChar(AnsiText), Length(Text)); |
// ...then assign ANSI string |
TTextDataFormat(Dest).Text := AnsiText; |
Result := True; |
end else |
Result := inherited AssignTo(Dest); |
end; |
|
|
//////////////////////////////////////////////////////////////////////////////// |
// |
// TCSVClipboardFormat |
// |
//////////////////////////////////////////////////////////////////////////////// |
var |
CF_CSV: TClipFormat = 0; |
|
function TCSVClipboardFormat.GetClipboardFormat: TClipFormat; |
begin |
if (CF_CSV = 0) then |
CF_CSV := RegisterClipboardFormat('CSV'); // *** DO NOT LOCALIZE *** |
Result := CF_CSV; |
end; |
|
function TCSVClipboardFormat.Assign(Source: TCustomDataFormat): boolean; |
begin |
if (Source is TTextDataFormat) then |
begin |
Lines.Text := TTextDataFormat(Source).Text; |
Result := True; |
end else |
Result := inherited AssignTo(Source); |
end; |
|
function TCSVClipboardFormat.AssignTo(Dest: TCustomDataFormat): boolean; |
begin |
if (Dest is TTextDataFormat) then |
begin |
TTextDataFormat(Dest).Text := Lines.Text; |
Result := True; |
end else |
Result := inherited AssignTo(Dest); |
end; |
|
|
//////////////////////////////////////////////////////////////////////////////// |
// |
// TLocaleClipboardFormat |
// |
//////////////////////////////////////////////////////////////////////////////// |
function TLocaleClipboardFormat.GetClipboardFormat: TClipFormat; |
begin |
Result := CF_LOCALE; |
end; |
|
function TLocaleClipboardFormat.HasData: boolean; |
begin |
Result := (Locale <> 0); |
end; |
|
function TLocaleClipboardFormat.Assign(Source: TCustomDataFormat): boolean; |
begin |
// So far we have no one to play with... |
Result := inherited Assign(Source); |
end; |
|
function TLocaleClipboardFormat.AssignTo(Dest: TCustomDataFormat): boolean; |
begin |
// So far we have no one to play with... |
Result := inherited AssignTo(Dest); |
end; |
|
|
//////////////////////////////////////////////////////////////////////////////// |
// |
// TDropTextTarget |
// |
//////////////////////////////////////////////////////////////////////////////// |
constructor TDropTextTarget.Create(AOwner: TComponent); |
begin |
inherited Create(AOwner); |
FTextFormat := TTextDataFormat.Create(Self); |
end; |
|
destructor TDropTextTarget.Destroy; |
begin |
FTextFormat.Free; |
inherited Destroy; |
end; |
|
function TDropTextTarget.GetText: string; |
begin |
Result := FTextFormat.Text; |
end; |
|
|
//////////////////////////////////////////////////////////////////////////////// |
// |
// TDropTextSource |
// |
//////////////////////////////////////////////////////////////////////////////// |
constructor TDropTextSource.Create(aOwner: TComponent); |
begin |
inherited Create(aOwner); |
FTextFormat := TTextDataFormat.Create(Self); |
end; |
|
destructor TDropTextSource.Destroy; |
begin |
FTextFormat.Free; |
inherited Destroy; |
end; |
|
function TDropTextSource.GetText: string; |
begin |
Result := FTextFormat.Text; |
end; |
|
procedure TDropTextSource.SetText(const Value: string); |
begin |
FTextFormat.Text := Value; |
end; |
|
//////////////////////////////////////////////////////////////////////////////// |
// |
// Initialization/Finalization |
// |
//////////////////////////////////////////////////////////////////////////////// |
|
initialization |
// Clipboard format registration |
TTextDataFormat.RegisterCompatibleFormat(TUnicodeTextClipboardFormat, 1, csSourceTarget, [ddRead]); |
TTextDataFormat.RegisterCompatibleFormat(TRichTextClipboardFormat, 2, csSourceTarget, [ddRead]); |
TTextDataFormat.RegisterCompatibleFormat(TOEMTextClipboardFormat, 2, csSourceTarget, [ddRead]); |
TTextDataFormat.RegisterCompatibleFormat(TCSVClipboardFormat, 3, csSourceTarget, [ddRead]); |
|
finalization |
// Clipboard format unregistration |
TUnicodeTextClipboardFormat.UnregisterClipboardFormat; |
TRichTextClipboardFormat.UnregisterClipboardFormat; |
TOEMTextClipboardFormat.UnregisterClipboardFormat; |
TCSVClipboardFormat.UnregisterClipboardFormat; |
end. |