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.