RealICQClient/Includes/DRAGDROP/Demo/VirtualFile/Main.pas

unit Main;

interface

uses
  Windows, Classes, Controls, Forms, ExtCtrls, StdCtrls,
  DragDrop, DropSource, DragDropFile, DropTarget, Graphics, ImgList;

type
  TVirtualFileDataFormat = class(TCustomDataFormat)
  private
    FContents: string;
    FFileName: string;
  public
    constructor Create(AOwner: TDragDropComponent); override;
    function Assign(Source: TClipboardFormat): boolean; override;
    function AssignTo(Dest: TClipboardFormat): boolean; override;
    procedure Clear; override;
    function HasData: boolean; override;
    function NeedsData: boolean; override;
    property FileName: string read FFileName write FFileName;
    property Contents: string read FContents write FContents;
  end;

  TFormMain = class(TForm)
    EditFilename: TEdit;
    Label1: TLabel;
    MemoContents: TMemo;
    Label2: TLabel;
    DropFileSource1: TDropFileSource;
    DropFileTarget1: TDropFileTarget;
    DropDummy1: TDropDummy;
    Panel2: TPanel;
    Memo1: TMemo;
    PanelDragDrop: TPanel;
    Image1: TImage;
    ImageList1: TImageList;
    procedure OnMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure DropFileTarget1Drop(Sender: TObject; ShiftState: TShiftState;
      Point: TPoint; var Effect: Integer);
  private
    { Private declarations }
    FSourceDataFormat: TVirtualFileDataFormat;
    FTargetDataFormat: TVirtualFileDataFormat;
  public
    { Public declarations }
  end;

var
  FormMain: TFormMain;

implementation

{$R *.DFM}

uses
  DragDropFormats,
  ShlObj,
  SysUtils;

procedure TFormMain.FormCreate(Sender: TObject);
begin
  // Disable all the normal data formats supported by the drag/drop components.
  // Note: We use TDropFileXXX components in this demo, but since we disable
  // all the default data formats and then add our own, any of the standard
  // source & target components could have been used.
  // We could have created pair of custom source and target components, but for
  // this demo it is much easier to just (mis)use some of the existing ones.
  while (DropFileSource1.DataFormats.Count > 0) do
    DropFileSource1.DataFormats.Remove(DropFileSource1.DataFormats[0]);
  while (DropFileTarget1.DataFormats.Count > 0) do
    DropFileTarget1.DataFormats.Remove(DropFileTarget1.DataFormats[0]);

  // Add our own custom data format to the drag/drop components.
  FSourceDataFormat := TVirtualFileDataFormat.Create(DropFileSource1);
  FTargetDataFormat := TVirtualFileDataFormat.Create(DropFileTarget1);
end;

procedure TFormMain.OnMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if DragDetectPlus(Handle, Point(X,Y)) then
  begin
    // Transfer the file name and contents to the data format...
    FSourceDataFormat.FileName := EditFileName.Text;
    FSourceDataFormat.Contents := MemoContents.Lines.Text;

    // ...and let it rip!
    DropFileSource1.Execute;
  end;
end;

procedure TFormMain.DropFileTarget1Drop(Sender: TObject;
  ShiftState: TShiftState; Point: TPoint; var Effect: Integer);
begin
  // Transfer the file name and contents from the data format.
  EditFileName.Text := FTargetDataFormat.FileName;
  MemoContents.Lines.Text := FTargetDataFormat.Contents;
end;


{ TVirtualFileDataFormat }

constructor TVirtualFileDataFormat.Create(AOwner: TDragDropComponent);
begin
  inherited Create(AOwner);

  // Add the "file group descriptor" and "file contents" clipboard formats to
  // the data format's list of compatible formats.
  // Note: This is normally done via TCustomDataFormat.RegisterCompatibleFormat,
  // but since this data format is only used here, it is just as easy for us to
  // add the formats manually.
  CompatibleFormats.Add(TFileContentsClipboardFormat.Create);
  CompatibleFormats.Add(TFileGroupDescritorClipboardFormat.Create);
end;

function TVirtualFileDataFormat.Assign(Source: TClipboardFormat): boolean;
begin
  Result := True;

  (*
  ** TFileContentsClipboardFormat
  *)
  if (Source is TFileContentsClipboardFormat) then
  begin
    FContents := TFileContentsClipboardFormat(Source).Data
  end else
  (*
  ** TFileGroupDescritorClipboardFormat
  *)
  if (Source is TFileGroupDescritorClipboardFormat) then
  begin
    if (TFileGroupDescritorClipboardFormat(Source).FileGroupDescriptor^.cItems > 0) then
      FFileName := TFileGroupDescritorClipboardFormat(Source).FileGroupDescriptor^.fgd[0].cFileName;
  end else
  (*
  ** None of the above...
  *)
    Result := inherited Assign(Source);
end;

function TVirtualFileDataFormat.AssignTo(Dest: TClipboardFormat): boolean;
var
  FGD			: TFileGroupDescriptor;
begin
  Result := True;

  (*
  ** TFileContentsClipboardFormat
  *)
  if (Dest is TFileContentsClipboardFormat) then
  begin
    TFileContentsClipboardFormat(Dest).Data := FContents;
  end else
  (*
  ** TFileGroupDescritorClipboardFormat
  *)
  if (Dest is TFileGroupDescritorClipboardFormat) then
  begin
    FillChar(FGD, SizeOf(FGD), 0);
    FGD.cItems := 1;
    StrLCopy(@FGD.fgd[0].cFileName[0], PChar(FFileName),
      SizeOf(FGD.fgd[0].cFileName));
    TFileGroupDescritorClipboardFormat(Dest).CopyFrom(@FGD);
  end else
  (*
  ** None of the above...
  *)
    Result := inherited AssignTo(Dest);
end;

procedure TVirtualFileDataFormat.Clear;
begin
  FFileName := '';
  FContents := ''
end;

function TVirtualFileDataFormat.HasData: boolean;
begin
  Result := (FFileName <> '');
end;

function TVirtualFileDataFormat.NeedsData: boolean;
begin
  Result := (FFileName = '') or (FContents = '');
end;

end.