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.