Subversion Repositories decoder

Rev

Go to most recent revision | Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
2 daniel-mar 1
unit DragDropFile;
2
 
3
// -----------------------------------------------------------------------------
4
// Project:         Drag and Drop Component Suite.
5
// Module:          DragDropFile
6
// Description:     Implements Dragging and Dropping of files and folders.
7
// Version:         4.0
8
// Date:            18-MAY-2001
9
// Target:          Win32, Delphi 5-6
10
// Authors:         Anders Melander, anders@melander.dk, http://www.melander.dk
11
// Copyright        © 1997-2001 Angus Johnson & Anders Melander
12
// -----------------------------------------------------------------------------
13
interface
14
 
15
uses
16
  DragDrop,
17
  DropTarget,
18
  DropSource,
19
  DragDropFormats,
20
  ActiveX,
21
  Windows,
22
  Classes;
23
 
24
type
25
////////////////////////////////////////////////////////////////////////////////
26
//
27
//              TFileClipboardFormat
28
//
29
////////////////////////////////////////////////////////////////////////////////
30
  TFileClipboardFormat = class(TCustomSimpleClipboardFormat)
31
  private
32
    FFiles: TStrings;
33
  protected
34
    function ReadData(Value: pointer; Size: integer): boolean; override;
35
    function WriteData(Value: pointer; Size: integer): boolean; override;
36
    function GetSize: integer; override;
37
  public
38
    constructor Create; override;
39
    destructor Destroy; override;
40
    function GetClipboardFormat: TClipFormat; override;
41
    function Assign(Source: TCustomDataFormat): boolean; override;
42
    function AssignTo(Dest: TCustomDataFormat): boolean; override;
43
    procedure Clear; override;
44
    function HasData: boolean; override;
45
    property Files: TStrings read FFiles;
46
  end;
47
 
48
////////////////////////////////////////////////////////////////////////////////
49
//
50
//              TFilenameClipboardFormat
51
//
52
////////////////////////////////////////////////////////////////////////////////
53
  TFilenameClipboardFormat = class(TCustomTextClipboardFormat)
54
  public
55
    function GetClipboardFormat: TClipFormat; override;
56
    function Assign(Source: TCustomDataFormat): boolean; override;
57
    function AssignTo(Dest: TCustomDataFormat): boolean; override;
58
    property Filename: string read GetString write SetString;
59
  end;
60
 
61
////////////////////////////////////////////////////////////////////////////////
62
//
63
//              TFilenameWClipboardFormat
64
//
65
////////////////////////////////////////////////////////////////////////////////
66
  TFilenameWClipboardFormat = class(TCustomWideTextClipboardFormat)
67
  public
68
    function GetClipboardFormat: TClipFormat; override;
69
    function Assign(Source: TCustomDataFormat): boolean; override;
70
    function AssignTo(Dest: TCustomDataFormat): boolean; override;
71
    property Filename: WideString read GetText write SetText;
72
  end;
73
 
74
////////////////////////////////////////////////////////////////////////////////
75
//
76
//              TFilenameMapClipboardFormat
77
//
78
////////////////////////////////////////////////////////////////////////////////
79
  // DONE -oanme -cStopShip : Rename TFilenameMapClipboardFormat to TFilenameMapClipboardFormat. Also wide version.
80
  TFilenameMapClipboardFormat = class(TCustomSimpleClipboardFormat)
81
  private
82
    FFileMaps           : TStrings;
83
  protected
84
    function ReadData(Value: pointer; Size: integer): boolean; override;
85
    function WriteData(Value: pointer; Size: integer): boolean; override;
86
    function GetSize: integer; override;
87
  public
88
    constructor Create; override;
89
    destructor Destroy; override;
90
    function GetClipboardFormat: TClipFormat; override;
91
    procedure Clear; override;
92
    function HasData: boolean; override;
93
    property FileMaps: TStrings read FFileMaps;
94
  end;
95
 
96
////////////////////////////////////////////////////////////////////////////////
97
//
98
//              TFilenameMapWClipboardFormat
99
//
100
////////////////////////////////////////////////////////////////////////////////
101
  TFilenameMapWClipboardFormat = class(TCustomSimpleClipboardFormat)
102
  private
103
    FFileMaps           : TStrings;
104
  protected
105
    function ReadData(Value: pointer; Size: integer): boolean; override;
106
    function WriteData(Value: pointer; Size: integer): boolean; override;
107
    function GetSize: integer; override;
108
  public
109
    constructor Create; override;
110
    destructor Destroy; override;
111
    function GetClipboardFormat: TClipFormat; override;
112
    procedure Clear; override;
113
    function HasData: boolean; override;
114
    property FileMaps: TStrings read FFileMaps;
115
  end;
116
 
117
 
118
////////////////////////////////////////////////////////////////////////////////
119
//
120
//              TFileMapDataFormat
121
//
122
////////////////////////////////////////////////////////////////////////////////
123
  TFileMapDataFormat = class(TCustomDataFormat)
124
  private
125
    FFileMaps           : TStrings;
126
  public
127
    constructor Create(AOwner: TDragDropComponent); override;
128
    destructor Destroy; override;
129
    function Assign(Source: TClipboardFormat): boolean; override;
130
    function AssignTo(Dest: TClipboardFormat): boolean; override;
131
    procedure Clear; override;
132
    function HasData: boolean; override;
133
    function NeedsData: boolean; override;
134
    property FileMaps: TStrings read FFileMaps;
135
  end;
136
 
137
////////////////////////////////////////////////////////////////////////////////
138
//
139
//              TFileDataFormat
140
//
141
////////////////////////////////////////////////////////////////////////////////
142
  TFileDataFormat = class(TCustomDataFormat)
143
  private
144
    FFiles              : TStrings;
145
  protected
146
  public
147
    constructor Create(AOwner: TDragDropComponent); override;
148
    destructor Destroy; override;
149
    function Assign(Source: TClipboardFormat): boolean; override;
150
    function AssignTo(Dest: TClipboardFormat): boolean; override;
151
    procedure Clear; override;
152
    function HasData: boolean; override;
153
    function NeedsData: boolean; override;
154
    property Files: TStrings read FFiles;
155
  end;
156
 
157
////////////////////////////////////////////////////////////////////////////////
158
//
159
//              TDropFileTarget
160
//
161
////////////////////////////////////////////////////////////////////////////////
162
  TDropFileTarget = class(TCustomDropMultiTarget)
163
  private
164
    FFileFormat         : TFileDataFormat;
165
    FFileMapFormat      : TFileMapDataFormat;
166
  protected
167
    function GetFiles: TStrings;
168
    function GetMappedNames: TStrings;
169
    function GetPreferredDropEffect: LongInt; override;
170
  public
171
    constructor Create(AOwner: TComponent); override;
172
    destructor Destroy; override;
173
    property Files: TStrings read GetFiles;
174
    property MappedNames: TStrings read GetMappedNames;
175
  end;
176
 
177
////////////////////////////////////////////////////////////////////////////////
178
//
179
//              TDropFileSource
180
//
181
////////////////////////////////////////////////////////////////////////////////
182
  TDropFileSource = class(TCustomDropMultiSource)
183
  private
184
    FFileFormat         : TFileDataFormat;
185
    FFileMapFormat      : TFileMapDataFormat;
186
    function GetFiles: TStrings;
187
    function GetMappedNames: TStrings;
188
  protected
189
    procedure SetFiles(AFiles: TStrings);
190
    procedure SetMappedNames(ANames: TStrings);
191
  public
192
    constructor Create(aOwner: TComponent); override;
193
    destructor Destroy; override;
194
  published
195
    property Files: TStrings read GetFiles write SetFiles;
196
    // MappedNames is only needed if files need to be renamed during a drag op.
197
    // E.g. dragging from 'Recycle Bin'.
198
    property MappedNames: TStrings read GetMappedNames write SetMappedNames;
199
  end;
200
 
201
 
202
////////////////////////////////////////////////////////////////////////////////
203
//
204
//              Component registration
205
//
206
////////////////////////////////////////////////////////////////////////////////
207
procedure Register;
208
 
209
 
210
////////////////////////////////////////////////////////////////////////////////
211
//
212
//              Misc.
213
//
214
////////////////////////////////////////////////////////////////////////////////
215
function ReadFilesFromHGlobal(const HGlob: HGlobal; Files: TStrings): boolean; // V4: renamed
216
function ReadFilesFromData(Data: pointer; Size: integer; Files: TStrings): boolean;
217
function ReadFilesFromZeroList(Data: pointer; Size: integer;
218
  Wide: boolean; Files: TStrings): boolean;
219
function WriteFilesToZeroList(Data: pointer; Size: integer;
220
  Wide: boolean; Files: TStrings): boolean;
221
 
222
 
223
////////////////////////////////////////////////////////////////////////////////
224
////////////////////////////////////////////////////////////////////////////////
225
//
226
//                      IMPLEMENTATION
227
//
228
////////////////////////////////////////////////////////////////////////////////
229
////////////////////////////////////////////////////////////////////////////////
230
implementation
231
 
232
uses
233
  DragDropPIDL,
234
  SysUtils,
235
  ShlObj;
236
 
237
////////////////////////////////////////////////////////////////////////////////
238
//
239
//              Component registration
240
//
241
////////////////////////////////////////////////////////////////////////////////
242
 
243
procedure Register;
244
begin
245
  RegisterComponents(DragDropComponentPalettePage, [TDropFileTarget,
246
    TDropFileSource]);
247
end;
248
 
249
 
250
////////////////////////////////////////////////////////////////////////////////
251
//
252
//              Utilities
253
//
254
////////////////////////////////////////////////////////////////////////////////
255
 
256
function ReadFilesFromHGlobal(const HGlob: HGlobal; Files: TStrings): boolean;
257
var
258
  DropFiles             : PDropFiles;
259
begin
260
  DropFiles := PDropFiles(GlobalLock(HGlob));
261
  try
262
    Result := ReadFilesFromData(DropFiles, GlobalSize(HGlob), Files)
263
  finally
264
    GlobalUnlock(HGlob);
265
  end;
266
end;
267
 
268
function ReadFilesFromData(Data: pointer; Size: integer; Files: TStrings): boolean;
269
var
270
  Wide                  : boolean;
271
begin
272
  Files.Clear;
273
  if (Data <> nil) then
274
  begin
275
    Wide := PDropFiles(Data)^.fWide;
276
    dec(Size, PDropFiles(Data)^.pFiles);
277
    inc(PChar(Data), PDropFiles(Data)^.pFiles);
278
    ReadFilesFromZeroList(Data, Size, Wide, Files);
279
  end;
280
 
281
  Result := (Files.Count > 0);
282
end;
283
 
284
function ReadFilesFromZeroList(Data: pointer; Size: integer;
285
  Wide: boolean; Files: TStrings): boolean;
286
var
287
  StringSize            : integer;
288
begin
289
  Result := False;
290
  if (Data <> nil) then
291
    while (Size > 0) and (PChar(Data)^ <> #0) do
292
    begin
293
      if (Wide) then
294
      begin
295
        Files.Add(PWideChar(Data));
296
        StringSize := (Length(PWideChar(Data)) + 1) * 2;
297
      end else
298
      begin
299
        Files.Add(PChar(Data));
300
        StringSize := Length(PChar(Data)) + 1;
301
      end;
302
      inc(PChar(Data), StringSize);
303
      dec(Size, StringSize);
304
      Result := True;
305
    end;
306
end;
307
 
308
function WriteFilesToZeroList(Data: pointer; Size: integer;
309
  Wide: boolean; Files: TStrings): boolean;
310
var
311
  i                     : integer;
312
begin
313
  Result := False;
314
  if (Data <> nil) then
315
  begin
316
    i := 0;
317
    dec(Size);
318
    while (Size > 0) and (i < Files.Count) do
319
    begin
320
      if (Wide) then
321
      begin
322
        StringToWideChar(Files[i], Data, Size);
323
        dec(Size, (Length(Files[i])+1)*2);
324
      end else
325
      begin
326
        StrPLCopy(Data, Files[i], Size);
327
        dec(Size, Length(Files[i])+1);
328
      end;
329
      inc(PChar(Data), Length(Files[i])+1);
330
      inc(i);
331
      Result := True;
332
    end;
333
 
334
    // Final teminating zero.
335
    if (Size >= 0) then
336
      PChar(Data)^ := #0;
337
  end;
338
end;
339
 
340
 
341
////////////////////////////////////////////////////////////////////////////////
342
//
343
//              TFileClipboardFormat
344
//
345
////////////////////////////////////////////////////////////////////////////////
346
constructor TFileClipboardFormat.Create;
347
begin
348
  inherited Create;
349
  FFiles := TStringList.Create;
350
  // Note: Setting dwAspect to DVASPECT_SHORT will request that the data source
351
  // returns the file names in short (8.3) format.
352
  // FFormatEtc.dwAspect := DVASPECT_SHORT;
353
end;
354
 
355
destructor TFileClipboardFormat.Destroy;
356
begin
357
  FFiles.Free;
358
  inherited Destroy;
359
end;
360
 
361
function TFileClipboardFormat.GetClipboardFormat: TClipFormat;
362
begin
363
  Result := CF_HDROP;
364
end;
365
 
366
procedure TFileClipboardFormat.Clear;
367
begin
368
  FFiles.Clear;
369
end;
370
 
371
function TFileClipboardFormat.HasData: boolean;
372
begin
373
  Result := (FFiles.Count > 0);
374
end;
375
 
376
function TFileClipboardFormat.GetSize: integer;
377
var
378
  i                     : integer;
379
begin
380
  Result := SizeOf(TDropFiles) + FFiles.Count + 1;
381
  for i := 0 to FFiles.Count-1 do
382
    inc(Result, Length(FFiles[i]));
383
end;
384
 
385
function TFileClipboardFormat.ReadData(Value: pointer;
386
  Size: integer): boolean;
387
begin
388
  Result := (Size > SizeOf(TDropFiles));
389
  if (not Result) then
390
    exit;
391
 
392
  Result := ReadFilesFromData(Value, Size, FFiles);
393
end;
394
 
395
function TFileClipboardFormat.WriteData(Value: pointer;
396
  Size: integer): boolean;
397
begin
398
  Result := (Size > SizeOf(TDropFiles));
399
  if (not Result) then
400
    exit;
401
 
402
  PDropFiles(Value)^.pfiles := SizeOf(TDropFiles);
403
  PDropFiles(Value)^.fwide := False;
404
  inc(PChar(Value), SizeOf(TDropFiles));
405
  dec(Size, SizeOf(TDropFiles));
406
 
407
  WriteFilesToZeroList(Value, Size, False, FFiles);
408
end;
409
 
410
function TFileClipboardFormat.Assign(Source: TCustomDataFormat): boolean;
411
begin
412
  if (Source is TFileDataFormat) then
413
  begin
414
    FFiles.Assign(TFileDataFormat(Source).Files);
415
    Result := True;
416
  end else
417
    Result := inherited Assign(Source);
418
end;
419
 
420
function TFileClipboardFormat.AssignTo(Dest: TCustomDataFormat): boolean;
421
begin
422
  if (Dest is TFileDataFormat) then
423
  begin
424
    TFileDataFormat(Dest).Files.Assign(FFiles);
425
    Result := True;
426
  end else
427
    Result := inherited AssignTo(Dest);
428
end;
429
 
430
 
431
////////////////////////////////////////////////////////////////////////////////
432
//
433
//              TFilenameClipboardFormat
434
//
435
////////////////////////////////////////////////////////////////////////////////
436
var
437
  CF_FILENAMEA: TClipFormat = 0;
438
 
439
function TFilenameClipboardFormat.GetClipboardFormat: TClipFormat;
440
begin
441
  if (CF_FILENAMEA = 0) then
442
    CF_FILENAMEA := RegisterClipboardFormat(CFSTR_FILENAMEA);
443
  Result := CF_FILENAMEA;
444
end;
445
 
446
function TFilenameClipboardFormat.Assign(Source: TCustomDataFormat): boolean;
447
begin
448
  if (Source is TFileDataFormat) then
449
  begin
450
    Result := (TFileDataFormat(Source).Files.Count > 0);
451
    if (Result) then
452
      Filename := TFileDataFormat(Source).Files[0];
453
  end else
454
    Result := inherited Assign(Source);
455
end;
456
 
457
function TFilenameClipboardFormat.AssignTo(Dest: TCustomDataFormat): boolean;
458
begin
459
  if (Dest is TFileDataFormat) then
460
  begin
461
    TFileDataFormat(Dest).Files.Add(Filename);
462
    Result := True;
463
  end else
464
    Result := inherited AssignTo(Dest);
465
end;
466
 
467
 
468
////////////////////////////////////////////////////////////////////////////////
469
//
470
//              TFilenameWClipboardFormat
471
//
472
////////////////////////////////////////////////////////////////////////////////
473
var
474
  CF_FILENAMEW: TClipFormat = 0;
475
 
476
function TFilenameWClipboardFormat.GetClipboardFormat: TClipFormat;
477
begin
478
  if (CF_FILENAMEW = 0) then
479
    CF_FILENAMEW := RegisterClipboardFormat(CFSTR_FILENAMEW);
480
  Result := CF_FILENAMEW;
481
end;
482
 
483
function TFilenameWClipboardFormat.Assign(Source: TCustomDataFormat): boolean;
484
begin
485
  if (Source is TFileDataFormat) then
486
  begin
487
    Result := (TFileDataFormat(Source).Files.Count > 0);
488
    if (Result) then
489
      Filename := TFileDataFormat(Source).Files[0];
490
  end else
491
    Result := inherited Assign(Source);
492
end;
493
 
494
function TFilenameWClipboardFormat.AssignTo(Dest: TCustomDataFormat): boolean;
495
begin
496
  if (Dest is TFileDataFormat) then
497
  begin
498
    TFileDataFormat(Dest).Files.Add(Filename);
499
    Result := True;
500
  end else
501
    Result := inherited AssignTo(Dest);
502
end;
503
 
504
 
505
////////////////////////////////////////////////////////////////////////////////
506
//
507
//              TFilenameMapClipboardFormat
508
//
509
////////////////////////////////////////////////////////////////////////////////
510
var
511
  CF_FILENAMEMAP: TClipFormat = 0;
512
 
513
constructor TFilenameMapClipboardFormat.Create;
514
begin
515
  inherited Create;
516
  FFileMaps := TStringList.Create;
517
end;
518
 
519
destructor TFilenameMapClipboardFormat.Destroy;
520
begin
521
  FFileMaps.Free;
522
  inherited Destroy;
523
end;
524
 
525
function TFilenameMapClipboardFormat.GetClipboardFormat: TClipFormat;
526
begin
527
  if (CF_FILENAMEMAP = 0) then
528
    CF_FILENAMEMAP := RegisterClipboardFormat(CFSTR_FILENAMEMAPA);
529
  Result := CF_FILENAMEMAP;
530
end;
531
 
532
procedure TFilenameMapClipboardFormat.Clear;
533
begin
534
  FFileMaps.Clear;
535
end;
536
 
537
function TFilenameMapClipboardFormat.HasData: boolean;
538
begin
539
  Result := (FFileMaps.Count > 0);
540
end;
541
 
542
function TFilenameMapClipboardFormat.GetSize: integer;
543
var
544
  i                     : integer;
545
begin
546
  Result := FFileMaps.Count + 1;
547
  for i := 0 to FFileMaps.Count-1 do
548
    inc(Result, Length(FFileMaps[i]));
549
end;
550
 
551
function TFilenameMapClipboardFormat.ReadData(Value: pointer;
552
  Size: integer): boolean;
553
begin
554
  Result := ReadFilesFromZeroList(Value, Size, False, FFileMaps);
555
end;
556
 
557
function TFilenameMapClipboardFormat.WriteData(Value: pointer;
558
  Size: integer): boolean;
559
begin
560
  Result := WriteFilesToZeroList(Value, Size, False, FFileMaps);
561
end;
562
 
563
 
564
////////////////////////////////////////////////////////////////////////////////
565
//
566
//              TFilenameMapWClipboardFormat
567
//
568
////////////////////////////////////////////////////////////////////////////////
569
var
570
  CF_FILENAMEMAPW: TClipFormat = 0;
571
 
572
constructor TFilenameMapWClipboardFormat.Create;
573
begin
574
  inherited Create;
575
  FFileMaps := TStringList.Create;
576
end;
577
 
578
destructor TFilenameMapWClipboardFormat.Destroy;
579
begin
580
  FFileMaps.Free;
581
  inherited Destroy;
582
end;
583
 
584
function TFilenameMapWClipboardFormat.GetClipboardFormat: TClipFormat;
585
begin
586
  if (CF_FILENAMEMAPW = 0) then
587
    CF_FILENAMEMAPW := RegisterClipboardFormat(CFSTR_FILENAMEMAPW);
588
  Result := CF_FILENAMEMAPW;
589
end;
590
 
591
procedure TFilenameMapWClipboardFormat.Clear;
592
begin
593
  FFileMaps.Clear;
594
end;
595
 
596
function TFilenameMapWClipboardFormat.HasData: boolean;
597
begin
598
  Result := (FFileMaps.Count > 0);
599
end;
600
 
601
function TFilenameMapWClipboardFormat.GetSize: integer;
602
var
603
  i                     : integer;
604
begin
605
  Result := FFileMaps.Count + 1;
606
  for i := 0 to FFileMaps.Count-1 do
607
    inc(Result, Length(FFileMaps[i]));
608
  inc(Result, Result);
609
end;
610
 
611
function TFilenameMapWClipboardFormat.ReadData(Value: pointer;
612
  Size: integer): boolean;
613
begin
614
  Result := ReadFilesFromZeroList(Value, Size, True, FFileMaps);
615
end;
616
 
617
function TFilenameMapWClipboardFormat.WriteData(Value: pointer;
618
  Size: integer): boolean;
619
begin
620
  Result := WriteFilesToZeroList(Value, Size, True, FFileMaps);
621
end;
622
 
623
 
624
////////////////////////////////////////////////////////////////////////////////
625
//
626
//              TFileMapDataFormat
627
//
628
////////////////////////////////////////////////////////////////////////////////
629
constructor TFileMapDataFormat.Create(AOwner: TDragDropComponent);
630
begin
631
  inherited Create(AOwner);
632
  FFileMaps := TStringList.Create;
633
  TStringList(FFileMaps).OnChanging := DoOnChanging;
634
end;
635
 
636
destructor TFileMapDataFormat.Destroy;
637
begin
638
  FFileMaps.Free;
639
  inherited Destroy;
640
end;
641
 
642
function TFileMapDataFormat.Assign(Source: TClipboardFormat): boolean;
643
begin
644
  Result := True;
645
 
646
  if (Source is TFilenameMapClipboardFormat) then
647
    FFileMaps.Assign(TFilenameMapClipboardFormat(Source).FileMaps)
648
 
649
  else if (Source is TFilenameMapWClipboardFormat) then
650
    FFileMaps.Assign(TFilenameMapWClipboardFormat(Source).FileMaps)
651
 
652
  else
653
    Result := inherited Assign(Source);
654
end;
655
 
656
function TFileMapDataFormat.AssignTo(Dest: TClipboardFormat): boolean;
657
begin
658
  Result := True;
659
 
660
  if (Dest is TFilenameMapClipboardFormat) then
661
    TFilenameMapClipboardFormat(Dest).FileMaps.Assign(FFileMaps)
662
 
663
  else if (Dest is TFilenameMapWClipboardFormat) then
664
    TFilenameMapWClipboardFormat(Dest).FileMaps.Assign(FFileMaps)
665
 
666
  else
667
    Result := inherited AssignTo(Dest);
668
end;
669
 
670
procedure TFileMapDataFormat.Clear;
671
begin
672
  FFileMaps.Clear;
673
end;
674
 
675
function TFileMapDataFormat.HasData: boolean;
676
begin
677
  Result := (FFileMaps.Count > 0);
678
end;
679
 
680
function TFileMapDataFormat.NeedsData: boolean;
681
begin
682
  Result := (FFileMaps.Count = 0);
683
end;
684
 
685
 
686
////////////////////////////////////////////////////////////////////////////////
687
//
688
//              TFileDataFormat
689
//
690
////////////////////////////////////////////////////////////////////////////////
691
constructor TFileDataFormat.Create(AOwner: TDragDropComponent);
692
begin
693
  inherited Create(AOwner);
694
  FFiles := TStringList.Create;
695
  TStringList(FFiles).OnChanging := DoOnChanging;
696
end;
697
 
698
destructor TFileDataFormat.Destroy;
699
begin
700
  FFiles.Free;
701
  inherited Destroy;
702
end;
703
 
704
function TFileDataFormat.Assign(Source: TClipboardFormat): boolean;
705
begin
706
  Result := True;
707
 
708
  if (Source is TFileClipboardFormat) then
709
    FFiles.Assign(TFileClipboardFormat(Source).Files)
710
 
711
  else if (Source is TPIDLClipboardFormat) then
712
    FFiles.Assign(TPIDLClipboardFormat(Source).Filenames)
713
 
714
  else
715
    Result := inherited Assign(Source);
716
end;
717
 
718
function TFileDataFormat.AssignTo(Dest: TClipboardFormat): boolean;
719
begin
720
  Result := True;
721
 
722
  if (Dest is TFileClipboardFormat) then
723
    TFileClipboardFormat(Dest).Files.Assign(FFiles)
724
 
725
  else if (Dest is TPIDLClipboardFormat) then
726
    TPIDLClipboardFormat(Dest).Filenames.Assign(FFiles)
727
 
728
  else
729
    Result := inherited AssignTo(Dest);
730
end;
731
 
732
procedure TFileDataFormat.Clear;
733
begin
734
  FFiles.Clear;
735
end;
736
 
737
function TFileDataFormat.HasData: boolean;
738
begin
739
  Result := (FFiles.Count > 0);
740
end;
741
 
742
function TFileDataFormat.NeedsData: boolean;
743
begin
744
  Result := (FFiles.Count = 0);
745
end;
746
 
747
 
748
////////////////////////////////////////////////////////////////////////////////
749
//
750
//              TDropFileTarget
751
//
752
////////////////////////////////////////////////////////////////////////////////
753
constructor TDropFileTarget.Create(AOwner: TComponent);
754
begin
755
  inherited Create(AOwner);
756
  OptimizedMove := True;
757
 
758
  FFileFormat := TFileDataFormat.Create(Self);
759
  FFileMapFormat := TFileMapDataFormat.Create(Self);
760
end;
761
 
762
destructor TDropFileTarget.Destroy;
763
begin
764
  FFileFormat.Free;
765
  FFileMapFormat.Free;
766
  inherited Destroy;
767
end;
768
 
769
function TDropFileTarget.GetFiles: TStrings;
770
begin
771
  Result := FFileFormat.Files;
772
end;
773
 
774
function TDropFileTarget.GetMappedNames: TStrings;
775
begin
776
  Result := FFileMapFormat.FileMaps;
777
end;
778
 
779
function TDropFileTarget.GetPreferredDropEffect: LongInt;
780
begin
781
  Result := inherited GetPreferredDropEffect;
782
  if (Result = DROPEFFECT_NONE) then
783
    Result := DROPEFFECT_COPY;
784
end;
785
 
786
 
787
////////////////////////////////////////////////////////////////////////////////
788
//
789
//              TDropFileSource
790
//
791
////////////////////////////////////////////////////////////////////////////////
792
constructor TDropFileSource.Create(aOwner: TComponent);
793
begin
794
  inherited Create(AOwner);
795
 
796
  FFileFormat := TFileDataFormat.Create(Self);
797
  FFileMapFormat := TFileMapDataFormat.Create(Self);
798
end;
799
 
800
destructor TDropFileSource.Destroy;
801
begin
802
  FFileFormat.Free;
803
  FFileMapFormat.Free;
804
  inherited Destroy;
805
end;
806
 
807
function TDropFileSource.GetFiles: TStrings;
808
begin
809
  Result := FFileFormat.Files;
810
end;
811
 
812
function TDropFileSource.GetMappedNames: TStrings;
813
begin
814
  Result := FFileMapFormat.FileMaps;
815
end;
816
 
817
procedure TDropFileSource.SetFiles(AFiles: TStrings);
818
begin
819
  FFileFormat.Files.Assign(AFiles);
820
end;
821
 
822
procedure TDropFileSource.SetMappedNames(ANames: TStrings);
823
begin
824
  FFileMapFormat.FileMaps.Assign(ANames);
825
end;
826
 
827
 
828
////////////////////////////////////////////////////////////////////////////////
829
//
830
//              Initialization/Finalization
831
//
832
////////////////////////////////////////////////////////////////////////////////
833
 
834
initialization
835
  // Data format registration
836
  TFileDataFormat.RegisterDataFormat;
837
  TFileMapDataFormat.RegisterDataFormat;
838
  // Clipboard format registration
839
  TFileDataFormat.RegisterCompatibleFormat(TFileClipboardFormat, 0, csSourceTarget, [ddRead]);
840
  TFileDataFormat.RegisterCompatibleFormat(TPIDLClipboardFormat, 1, csSourceTarget, [ddRead]);
841
  TFileDataFormat.RegisterCompatibleFormat(TFilenameClipboardFormat, 2, csSourceTarget, [ddRead]);
842
  TFileDataFormat.RegisterCompatibleFormat(TFilenameWClipboardFormat, 2, csSourceTarget, [ddRead]);
843
 
844
  TFileMapDataFormat.RegisterCompatibleFormat(TFilenameMapClipboardFormat, 0, csSourceTarget, [ddRead]);
845
  TFileMapDataFormat.RegisterCompatibleFormat(TFilenameMapWClipboardFormat, 0, csSourceTarget, [ddRead]);
846
 
847
finalization
848
  // Data format unregistration
849
  TFileDataFormat.UnregisterDataFormat;
850
  TFileMapDataFormat.UnregisterDataFormat;
851
 
852
  // Clipboard format unregistration
853
  TFileClipboardFormat.UnregisterClipboardFormat;
854
  TFilenameClipboardFormat.UnregisterClipboardFormat;
855
  TFilenameWClipboardFormat.UnregisterClipboardFormat;
856
  TFilenameMapClipboardFormat.UnregisterClipboardFormat;
857
  TFilenameMapWClipboardFormat.UnregisterClipboardFormat;
858
end.