Project source
Form source (Pascal)
Form source (DFM)
Project source: FileContentsTest2.dpr |
program FileContentsTest2; uses Forms, fmFileContentsTest2 in 'fmFileContentsTest2.pas' {Form1}; {$R *.RES} begin Application.Initialize; Application.CreateForm(TForm1, Form1); Application.Run; end.Back to top |
Form source: fmFileContentsTest2.pas |
unit fmFileContentsTest2; { UnitOOPS OLE Drag and Drop Components - Example for dropping multiple new files in Explorer or the desktop based on in-memory content. Multiple-file version of FileContentsTest.dpr. Last modified: 03/23/2001} interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, uoole, ComCtrls, StdCtrls, ExtCtrls; type TForm1 = class(TForm) GroupBox1: TGroupBox; Panel1: TPanel; Label1: TLabel; Edit1: TEdit; UpDown1: TUpDown; GroupBox2: TGroupBox; ListView1: TListView; UOTextSource1: TUOTextSource; UOTextTarget1: TUOTextTarget; procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure UOTextSource1RenderCustomFormat(Sender: TObject; const formatName: String; var formatContent: String); procedure UOTextTarget1Drop(Sender: TObject; Acceptor: TWinControl; const dropText: String; X, Y: Integer); procedure FormCreate(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation uses uoUtil, ShlObj, ActiveX; {$R *.DFM} function GetContentsForFileIndex(index: integer): string; // Given a 1-based index, return something to put in the file. We do it here // so we can call it to get its length at a different time. In a practical // application, this would be the binary contents of a file, supplied on a // string. // Returns '1Contents for file 1' when index = 1 // '22Contents for file 2' when index = 2, etc. // Testing purposes - if index is <= 0, return blank. var fmtString: string; begin // Uncomment to demonstrate the case where blank contents cause no file to be created // In this case File1.txt will never be created. See UOTextSource1RenderCustomFormat below // for more information. //if (index = 1) then //begin // Result := ''; // Exit; //end; fmtString := StringOfChar(IntToStr(index)[1], index); Result := Format(fmtString + 'Contents for file %d', [index]); end; function uoFileGroupDescriptorFromFileListEx(const rootDir: string; fileList: TStringList; sizes: array of integer): string; // Build a FileGroupDescriptor structure in a string. Useful for descriptive info // about files being dragged. Entirely optional. If rootDir is '', the list is assumed // to be fully qualified. If a file doesn't exist, we look first in the Objects[] array for // the attribute. If it's not there, we give it the faArchive attribute. var aFd: TFileDescriptor; aFileName: string; aString: string; j: integer; useSlash: boolean; aUINT: UINT; begin result := ''; // Fall-through value useSlash := (rootDir <> '') and (rootDir[length(rootDir)] <> '\'); with fileList do begin // Put the file count at the head of the FILEGROUPDESCRIPTOR structure. aUint := Count; result := uoEncodeDWORDToString(aUINT); // The remainder of the structure is an array of FILEDESCRIPTOR structures. for j := 1 to Count do // Iterate begin if useSlash then aFileName := rootDir + '\' + Strings[j-1] else aFileName := rootDir + Strings[j-1]; // Build a file descriptor for this file. // Bare-bones - pass only the file attributes. We could also pass // file creation/mod dates, file sizes, etc, etc. FillChar(aFd, sizeOf(aFd), 0); with aFd do begin dwFlags := FD_ATTRIBUTES; // Do we have file sizes? if (high(sizes) >= Count-1) then dwFlags := dwFlags or FD_FILESIZE; // Existing file - get the attributes if FileExists(aFileName) then dwFileAttributes := FileGetAttr(aFileName) else begin // Non-existent file - did the user pass us attributes in Objects[]? dwFileAttributes := DWORD(Objects[j-1]); // No attributes passed - assume this is a regular file if (dwFileAttributes = 0) then begin dwFileAttributes := faArchive; end; end; strCopy(cFileName, PChar(aFileName)); // Size if ((dwFlags and FD_FILESIZE) <> 0) then begin nFileSizeLow := sizes[j-1]; nFileSizeHigh := 0; // Limit to files of size MaxInt end; end; // with // Put the file descriptor on a temp string SetLength(aString, sizeOf(TFileDescriptor)); System.Move(aFd, aString[1], sizeOf(TFileDescriptor)); // And add that string to the result result := result + aString; end; // for end; // with end; procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var j: integer; begin // Detect a drag if uoDragDetect(Panel1.Handle, POINT(X,Y), UOTextSource1.MouseButton) then begin with UOTextSource1, CustomFormatData do begin // Always clear to prevent formats accumulating between drags. Clear; // A file group descriptor, so we'll find out about the file // names dropped. Use a blank string so we'll get asked for these // at drop-time. AddFormat('FileGroupDescriptor', ''); // The file contents for each file we might be asked to fill in. Use // a blank string for each so we'll get asked at drop time. for j := 1 to UpDown1.Max do begin AddFormatEx('FileContents', '', TYMED_HGLOBAL, j-1); // Make sure we don't get a trailing null. // Items[Count-1] is the TCustomFormatData we just added. Items[Count-1].AllowTrailingNull := false; end; // Finally, start the drag Execute; end; end; end; procedure TForm1.UOTextSource1RenderCustomFormat(Sender: TObject; const formatName: String; var formatContent: String); // Delay render handler. Any formats we didn't supply at drag-time will be // requested here. You don't have to do it this way, but it's handy for resource // management, in the case where you need to supply a lot of formats but the // user will be accepting only a small subset of them. var aCDF: TCustomFormatData; aSL: TStringList; nFiles: integer; j: integer; sizes: array of integer; begin // We get called here at drop-time to provide the // content for each format we didn't specify at drag-time. if (AnsiCompareText(formatName, 'FileGroupDescriptor') = 0) then begin // File group descriptor. We'll pass however many file names we were asked // for in the UI nFiles := UpDown1.Position; SetLength(Sizes, nFiles); aSL := TStringList.Create; try for j := 1 to nFiles do // Iterate begin // Get a content size from the same function that will later create the // content (or a shortcut, in the general case) sizes[j-1] := Length(GetContentsForFileIndex(j)); // Get a file name for each. If the content is going to be zero, blank out // the name, which will prevent the file being created. if (sizes[j-1] <> 0) then aSL.Add(Format('File%d.txt', [j])) else aSL.Add(''); end; // for // Use the extended function to supply sizes. formatContent := uoFileGroupDescriptorFromFileListEx('', aSL, sizes); finally aSL.Free; end; end; if (AnsiCompareText(formatName, 'FileContents') = 0) then begin // File contents. Since we passed nFiles file names above, we'll get called // once for each of the nFiles indices 0..nFiles-1. // Get the TCustomFormatData object that was last requested aCDF := UOTextSource1.CustomFormatData[UOTextSource1.CustomFormatIndex]; // Depending on the index, return the content. formatContent := GetContentsForFileIndex(aCDF.lIndex+1); end; end; procedure TForm1.UOTextTarget1Drop(Sender: TObject; Acceptor: TWinControl; const dropText: String; X, Y: Integer); // On drop, put the file names and content into a TListView. In a real application, // of course, you'd create the files. var aString: string; j: integer; aSL: TStringList; begin // Clear the list view ListView1.Items.Clear; // Get the file group descriptor information aString := UOTextTarget1.DataObjectGetFormat('FileGroupDescriptor'); aSL := uoFileListFromFileGroupDescriptor(aString); // Now, loop over the files, looking for content try for j := 1 to aSL.Count do begin // Tell the target which index we're looking for DataObjectlIndex := j-1; // Get the content aString := UOTextTarget1.DataObjectGetFormat('FileContents'); // Add a new item to the list view, and fill in the name and contents with ListView1.Items.Add do begin Caption := aSL[j-1]; SubItems.Add(aString); //SubItems.Add(IntToStr(length(aString))); end; end; finally aSL.Free; end; end; procedure TForm1.FormCreate(Sender: TObject); begin // Tell the text target we're looking for these formats with UOTextTarget1, CustomFormats do begin Add('FileGroupDescriptor'); Add('FileContents'); end; // with end; end.Back to top |
Form source: fmFileContentsTest2.dfm |
object Form1: TForm1 Left = 192 Top = 110 BorderStyle = bsDialog Caption = 'Drag and drop of multiple file contents' ClientHeight = 330 ClientWidth = 555 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] OldCreateOrder = False OnCreate = FormCreate PixelsPerInch = 96 TextHeight = 13 object GroupBox1: TGroupBox Left = 4 Top = 2 Width = 545 Height = 141 Caption = 'Source' TabOrder = 0 object Label1: TLabel Left = 11 Top = 109 Width = 135 Height = 13 Caption = 'Number of text files to drop: ' end object Panel1: TPanel Left = 13 Top = 18 Width = 521 Height = 81 BorderWidth = 3 Caption = 'Drag from this panel (to Explorer or the list view below) to dro' + 'p multiple text files at the same time.' TabOrder = 0 OnMouseDown = Panel1MouseDown end object Edit1: TEdit Left = 148 Top = 106 Width = 80 Height = 21 TabOrder = 1 Text = '3' end object UpDown1: TUpDown Left = 228 Top = 106 Width = 12 Height = 21 Associate = Edit1 Min = 1 Max = 10 Position = 3 TabOrder = 2 Wrap = False end end object GroupBox2: TGroupBox Left = 4 Top = 147 Width = 545 Height = 177 Caption = 'Target' TabOrder = 1 object ListView1: TListView Left = 12 Top = 16 Width = 522 Height = 150 Columns = < item AutoSize = True Caption = 'File Name' end item Caption = 'File Contents' Width = 300 end> TabOrder = 0 ViewStyle = vsReport end end object UOTextSource1: TUOTextSource OnRenderCustomFormat = UOTextSource1RenderCustomFormat DropEffects = [deCopy] MouseButton = mbLeft Left = 377 Top = 90 end object UOTextTarget1: TUOTextTarget AcceptorControl = ListView1 AcceptTextFormats = [dtfCustom] OnDrop = UOTextTarget1Drop Left = 412 Top = 226 end endBack to top |